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.

ArrowMain

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.

ArrowOutput

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]