eliminare i record duplicati che utilizzano VBA in Microsoft Excel
In questo articolo creeremo una macro per rimuovere i record duplicati dai dati.
I dati grezzi sono costituiti dai dati dei dipendenti, che includono nome, età e sesso.
Spiegazione logica
Abbiamo creato una macro “RemovingDuplicate” per rimuovere i record duplicati dai dati. Questa macro innanzitutto genera i dati in una sequenza e quindi effettua il confronto tra i valori di due righe consecutive per trovare i record duplicati.
Spiegazione del codice
ActiveSheet.Sort.SortFields.Clear Il codice precedente viene utilizzato per rimuovere qualsiasi precedente ordinamento sui dati.
ActiveSheet.Sort.SortFields.Add Chiave: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers Il codice precedente viene utilizzato per ordinare i dati nella prima colonna in ordine crescente.
For i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Step -1 Il codice precedente viene utilizzato per applicare il ciclo inverso, a partire dall’ultima riga alla riga selezionata.
ActiveSheet.Rows (i) .Delete shift: = xlUp Il codice sopra viene utilizzato per eliminare una riga e spostare il cursore sulla riga superiore.
Segui sotto per il codice
Option Explicit Sub RemovingDuplicate() 'Declaring variables Dim i As Long 'Disabling screen updates Application.ScreenUpdating = False Range("A11").Select ActiveSheet.Sort.SortFields.Clear 'Sorting data in ascending order ActiveSheet.Sort.SortFields.Add Key:=Range(Selection.Address), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers With ActiveSheet.Sort .SetRange Range(Selection.Offset(1, 0), ActiveSheet.Cells(Rows.Count, Selection.End(xlToRight).Column).End(xlUp)) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Looping through all the cells For i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1 'Comparing value of two adjacent cells for duplicate records If ActiveSheet.Cells(i, Selection.Column).Value = ActiveSheet.Cells((i - 1), Selection.Column).Value Then 'Delete the duplicate record ActiveSheet.Rows(i).Delete shift:=xlUp End If Next i 'Enabling screen updates Application.ScreenUpdating = True End Sub
Se ti è piaciuto questo blog, condividilo con i tuoi amici su Facebook e Facebook.
Ci piacerebbe sentire la tua opinione, facci sapere come possiamo migliorare il nostro lavoro e renderlo migliore per te. Scrivici a [email protected]