Elimina i record duplicati utilizzando VBA in Microsoft Excel

Anonim

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 genera innanzitutto i dati in una sequenza e quindi effettua il confronto tra i valori di due righe consecutive per scoprire i record duplicati.

Spiegazione del codice

ActiveSheet.Sort.SortFields.Clear

Il codice sopra viene utilizzato per rimuovere qualsiasi ordinamento precedente sui dati.

ActiveSheet.Sort.SortFields.Add Key:=Range(Selection.Address), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers

Il codice sopra viene utilizzato per ordinare i dati nella prima colonna in ordine crescente.

Per i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 passaggio -1

Il codice sopra viene utilizzato per applicare il ciclo inverso, a partire dall'ultima riga fino alla riga selezionata.

ActiveSheet.Rows(i).Elimina shift:=xlUp

Il codice sopra viene utilizzato per eliminare una riga e spostare il cursore sulla riga superiore.

Si prega di seguire sotto per il codice

 Option Explicit Sub RemovalDuplicate() 'Dichiarazione delle variabili Dim i As Long 'Disabilitazione degli aggiornamenti dello schermo Application.ScreenUpdating = False Range("A11").Select ActiveSheet.Sort.SortFields.Clear 'Ordinamento dei dati in ordine crescente 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 'Loop attraverso tutte le celle per i = ActiveSheet.Cells(Rows. Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1 'Confronto del valore di due celle adiacenti per i record duplicati If ActiveSheet.Cells(i, Selection.Column).Value = ActiveSheet.Cells( (i - 1), Selection.Column).Value Then 'Elimina il record duplicato ActiveSheet.Rows(i).Delete shift:=xlUp End If Next i 'Abilitazione screen up date Application.ScreenUpdating = True End Sub 

Se ti è piaciuto questo blog, condividilo con i tuoi amici su Facebook. Inoltre, puoi seguirci su Twitter e Facebook.

Ci piacerebbe avere tue notizie, facci sapere come possiamo migliorare il nostro lavoro e renderlo migliore per te. Scrivici al sito di posta elettronica