Löschen doppelte Datensätze mit VBA in Microsoft Excel
In diesem Artikel erstellen wir ein Makro, um doppelte Datensätze aus den Daten zu entfernen.
Rohdaten bestehen aus Mitarbeiterdaten, einschließlich Name, Alter und Geschlecht.
Logische Erklärung
Wir haben ein Makro „RemovingDuplicate“ erstellt, um doppelte Datensätze aus den Daten zu entfernen. Dieses Makro bezieht zuerst die Daten in einer Sequenz und vergleicht dann die Werte zweier aufeinanderfolgender Zeilen, um doppelte Datensätze zu ermitteln.
Code Erklärung
ActiveSheet.Sort.SortFields.Clear Mit dem obigen Code werden alle vorherigen Sortierungen der Daten entfernt.
ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers Der obige Code wird verwendet, um die Daten in der ersten Spalte in aufsteigender Reihenfolge zu sortieren.
Für i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Schritt -1 Der obige Code wird verwendet, um eine umgekehrte Schleife anzuwenden, beginnend mit der letzten Zeile bis zur ausgewählten Zeile.
ActiveSheet.Rows (i) .Delete shift: = xlUp Der obige Code wird verwendet, um eine Zeile zu löschen und den Cursor in die obere Zeile zu bewegen.
Bitte folgen Sie unten für den Code
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
Wenn dir dieser Blog gefallen hat, teile ihn mit deinen Freunden auf Facebook und Facebook.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns unter [email protected]