Cella attiva che si sposta nell'ordinamento

Question

Ciao a tutti,

Utilizzo un file con codice scritto da Norman che mi permette di ordinare le righe mediante vba. La mia domanda è molto semplice, Quando modifico la data nella colonna B, la riga si sposta in base alle altre date. Si può fare in modo che quando la riga si sposta, la cella attiva dove si è intervenuti per fare la modifica, si sposta insieme con la riga? Il file che utilizzo, lo trovate qui.

Answer 1

Ciao Geacs,

Ciao Norman,

Ti chiedo scusa se riapro il thread. Usando il file ho riscontrato che quando intervengo nelle colonne D, E, J e K che contengono delle convalide dati, la cella attiva non si sposta. Ho provato ad adattare il codice, ma senza risultati. Potresti aggiungere il codice necessario per fare in modo che la cella attiva si sposta? Grazie e scusami ancora se non l'ho fatto notare prima.

Il mio codice ha preso in considerazione solo la modifica di una data (nella colonna B o H) perché era quello che la tua richiesta sembrava chiedere:

Quando modifico la data nella colonna B, la riga si sposta in base alle altre date. Si può fare in modo che quando la riga si sposta, la cella attiva dove si è intervenuti per fare la modifica, si sposta insieme con la riga?

Tuttavia, per ordinare le tabelle anche in risposta alle modifiche delle colonne D:E (o, analogamente, J:K) e seguire la cella modificata nella sua nuova posizione, sostituisci la procedura Worksheet_Change con la seguente versione:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range 

Dim Rng3 As Range, Rng4 As Range 

Dim rFind As Range 

Dim iRow As Long, jRow As Long 

Dim CalcMode As Long 

Dim sName As String 

Const sColonne As String = **"B:F"** 

Const sColonne2 As String = **"H:L"** 

Const iPrimaRiga As Long = **2** 

Const iPrimaRiga2 As Long = **3** 

On Error GoTo XIT 

With Application 

    CalcMode = .Calculation 

    .Calculation = xlCalculationManual 

    .ScreenUpdating = False 

End With 

With Me 

    iRow = LastRow(Me, .Columns(sColonne)) 

    jRow = LastRow(Me, .Columns(sColonne2)) 

    Set Rng = .Range(sColonne).Resize(iRow - iPrimaRiga + 1). \_ 

        Offset(iPrimaRiga - 1) 

    Set Rng2 = .Range(sColonne2).Resize(jRow - iPrimaRiga2 + 1). \_ 

        Offset(iPrimaRiga2 - 1) 

End With 

Set Rng3 = Intersect(Rng, Target) 

Set Rng4 = Intersect(Rng2, Target) 

If Not Rng3 Is Nothing Then 

    sName = Intersect(Rng3.EntireRow, Rng.Columns(2)).Value 

    Call SortIt(Me, Rng) 

    Set rFind = Rng.Columns(2).Find(What:=sName, After:=Rng.Cells(1, 2), LookIn:=xlFormulas2, \_ 

        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, \_ 

        MatchCase:=False, SearchFormat:=False) 

    Intersect(rFind.EntireRow, Target.EntireColumn).Select 

End If 

If Not Rng4 Is Nothing Then 

    sName = Intersect(Rng4.EntireRow, Rng2.Columns(2)).Value 

    Call SortIt(Me, Rng2) 

    Set rFind = Rng2.Columns(2).Find(What:=sName, After:=Rng2.Cells(1, 2), LookIn:=xlFormulas2, \_ 

        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, \_ 

        MatchCase:=False, SearchFormat:=False) 

    Intersect(rFind.EntireRow, Target.EntireColumn).Select 

End If 

XIT:

With Application 

    .Calculation = CalcMode 

    .ScreenUpdating = True 

End With 

End Sub

'<<=========

Nel modulo standard Module1, sostituisci anche la procedura SortIt con questa versione:

'--------->>

Public Sub SortIt(SH As Worksheet, aRng As Range)

With SH.Sort 

    With .SortFields 

        .Clear 

        .Add Key:=aRng.Columns(1), \_ 

             SortOn:=xlSortOnValues, \_ 

             Order:=xlAscending, \_ 

             DataOption:=xlSortNormal 

         .Add Key:=aRng.Columns(2), \_ 

             SortOn:=xlSortOnValues, \_ 

             Order:=xlAscending, DataOption:=xlSortNormal 

        .Add Key:=aRng.Columns(4), \_ 

             SortOn:=xlSortOnValues, \_ 

             Order:=xlAscending, DataOption:=xlSortNormal 

        .Add Key:=aRng.Columns(3), \_ 

             SortOn:=xlSortOnValues, \_ 

             Order:=xlAscending, \_ 

             DataOption:=xlSortNormal 

    End With 

    .SetRange aRng 

    .Header = xlNo 

    .MatchCase = False 

    .Orientation = xlTopToBottom 

    .SortMethod = xlPinYin 

    .Apply 

End With 

End Sub

'--------->>

Potresti scaricare il mio file di prova aggiornato Geacs2021004.xlsm

===

Regards,

Norman

Answer 2

Ciao Geacs,

Ti ringrazio per il cortese riscontro.

Sono felice che il codice ti sia stato utile e, come sempre, è stato un piacere aiutarti.

Alla prossima.

===

Regards,

Norman

Answer 3

Ciao Norman,

Sei grandissimo, funziona da fare meraviglia. Un grande, grande grazie

Answer 4

Ciao Geacs,

Utilizzo un file con codice scritto da Norman che mi permette di ordinare le righe mediante vba. La mia domanda è molto semplice, Quando modifico la data nella colonna B, la riga si sposta in base alle altre date. Si può fare in modo che quando la riga si sposta, la cella attiva dove si è intervenuti per fare la modifica, si sposta insieme con la riga? Il file che utilizzo, lo trovate qui.

Prova a sostituire la procedura Worksheet_Change con la seguente versione:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Rng2 As Range 

Dim Rng3 As Range, Rng4 As Range 

Dim rFind As Range 

Dim iRow As Long, jRow As Long 

Dim CalcMode As Long 

Dim sName As String 

Const sColonne As String = "B:F" 

Const sColonne2 As String = "H:L" 

Const iPrimaRiga As Long = 2 

Const iPrimaRiga2 As Long = 3 

On Error GoTo XIT 

With Application 

    CalcMode = .Calculation 

    .Calculation = xlCalculationManual 

    .ScreenUpdating = False 

End With 

With Me 

    iRow = LastRow(Me, .Columns(sColonne)) 

    jRow = LastRow(Me, .Columns(sColonne2)) 

    Set Rng = .Range(sColonne).Resize(iRow - iPrimaRiga + 1). \_ 

        Offset(iPrimaRiga - 1) 

    Set Rng2 = .Range(sColonne2).Resize(jRow - iPrimaRiga2 + 1). \_ 

        Offset(iPrimaRiga2 - 1) 

End With 

Set Rng3 = Intersect(Rng, Target) 

Set Rng4 = Intersect(Rng2, Target) 

If Not Rng3 Is Nothing Then 

    sName = Rng3.Offset(0, 1) 

    Call SortIt(Me, Rng) 

    Set rFind = Rng.Columns(2).Find(What:=sName, After:=Rng.Cells(1, 2), LookIn:=xlFormulas2, \_ 

        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, \_ 

        MatchCase:=False, SearchFormat:=False) 

    rFind.Offset(0, -1).Select 

End If 

If Not Rng4 Is Nothing Then 

    sName = Rng4.Offset(0, 1) 

    Call SortIt(Me, Rng2) 

    Set rFind = Rng2.Columns(2).Find(What:=sName, After:=Rng2.Cells(1, 2), LookIn:=xlFormulas2, \_ 

        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, \_ 

        MatchCase:=False, SearchFormat:=False) 

    rFind.Offset(0, -1).Select 

End If 

XIT:

With Application 

    .Calculation = CalcMode 

    .ScreenUpdating = True 

End With 

End Sub

'<<=========

Potresti scaricare il mio file di prova Geacs2021003.xlsm

===

Regards,

Norman

Answer 5

Ciao

Sono Adeyemi e sarei felice di aiutarti con la tua domanda.

Per spostare la cella attiva insieme alla riga quando si ordinano i dati, è possibile memorizzare l'indirizzo della cella attiva prima dell'ordinamento e quindi selezionarla nuovamente dopo l'ordinamento. Ecco un esempio di come è possibile modificare il codice:

'''VBA Sub SortData() Dim rng come intervallo Dim ActiveCellAddress come stringa

Memorizza l'indirizzo della cella attiva ActiveCellAddress = ActiveCell.Address

Define the range to be sorted Set rng = ThisWorkbook.Worksheets("Sheet1"). Intervallo("A1:B10")

Ordina l'intervallo rng. Chiave di ordinamento1:=rng. Colonne(2), Ordine1:=xlAscending, Intestazione:=xlYes

Reselect the active cell Range(ActiveCellAddress). Selezionare Fine sub

In questo codice, 'ActiveCell.Address' viene utilizzato per memorizzare l'indirizzo della cella attiva prima dell'ordinamento. Dopo l'ordinamento, 'Range(ActiveCellAddress). Select' viene utilizzato per riselezionare la cella attiva.

Sostituire '"Foglio1"' e '"A1:B10"' con il nome e l'intervallo effettivi del foglio di lavoro. Inoltre, assicurati che il tuo progetto VBA sia stato salvato prima di eseguire questo codice, in quanto potrebbe potenzialmente portare alla perdita di dati in caso di errori. 

Spero che questo aiuti

Restituisci alla comunità. Aiuta la prossima persona che ha questo problema indicando se questa risposta ha risolto il tuo problema. Fai clic su Sì o No di seguito

Saluti
Adeyemi  

*Questa risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o espressioni strane.*