In dit artikel gaan we een macro maken om dubbele records uit de gegevens te verwijderen.
Ruwe gegevens bestaan uit werknemersgegevens, waaronder Naam, Leeftijd en Geslacht.
Logische uitleg
We hebben een macro "RemovingDuplicate" gemaakt om dubbele records uit de gegevens te verwijderen. Deze macro haalt eerst de gegevens in een reeks en maakt vervolgens een vergelijking tussen waarden van twee opeenvolgende rijen om dubbele records te vinden.
Code uitleg
ActiveSheet.Sort.SortFields.Clear
De bovenstaande code wordt gebruikt om eerdere sorteringen op de gegevens te verwijderen.
ActiveSheet.Sort.SortFields.Add Key:=Bereik (Selection.Address), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
De bovenstaande code wordt gebruikt om de gegevens in de eerste kolom in oplopende volgorde te sorteren.
Voor i = ActiveSheet.Cells(Rows.Count, Selection.Column).End(xlUp).Rij naar selectie.Rij + 1 stap -1
De bovenstaande code wordt gebruikt om reverse looping toe te passen, beginnend bij de laatste rij tot de geselecteerde rij.
ActiveSheet.Rows(i).Verwijder shift:=xlUp
De bovenstaande code wordt gebruikt om een rij te verwijderen en de cursor naar de bovenste rij te verplaatsen.
Volg hieronder voor de code:
Optie Explicit Sub RemovalDuplicate() 'Variabelen Dim i As Long declareren 'Schermupdates uitschakelen Application.ScreenUpdating = False Range("A11").Select ActiveSheet.Sort.SortFields.Clear 'Gegevens in oplopende volgorde sorteren 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 'Door alle cellen doorlopen For i = ActiveSheet.Cells(Rijen. Count, Selection.Column).End(xlUp).Row To Selection.Row + 1 Step -1 'Waarde van twee aangrenzende cellen vergelijken voor dubbele records If ActiveSheet.Cells(i, Selection.Column).Value = ActiveSheet.Cells( (i - 1), Selectie.Kolom).Waarde Dan 'Verwijder de dubbele record ActiveSheet.Rows(i).Verwijder shift:=xlOmhoog Einde Als Volgende i 'Scherm omhoog inschakelen datums Application.ScreenUpdating = True End Sub
Als je deze blog leuk vond, deel hem dan met je vrienden op Facebook. Ook kunt u ons volgen op Twitter en Facebook.
We horen graag van u, laat ons weten hoe we ons werk kunnen verbeteren en voor u kunnen verbeteren. Schrijf ons op de e-mailsite