I den här artikeln kommer vi att skapa ett makro för att ta bort dubblettposter från data.
Rådata består av medarbetardata, som inkluderar namn, ålder och kön.
Logisk förklaring
Vi har skapat ett makro “RemovingDuplicate” för att ta bort dubblettposter från data. Detta makro först källar data i en sekvens och gör sedan jämförelse mellan värdena på två på varandra följande rader för att ta reda på dubbletter.
Kodförklaring
ActiveSheet.Sort.SortFields.Clear
Ovanstående kod används för att ta bort tidigare sortering av data.
ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _
SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers
Ovanstående kod används för att sortera data i den första kolumnen i stigande ordning.
För i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Steg -1
Ovanstående kod används för att tillämpa omvänd looping, från sista raden till den valda raden.
ActiveSheet.Rows (i) .Delete shift: = xlUp
Ovanstående kod används för att radera en rad och flytta markören till den övre raden.
Följ koden nedan
Alternativ Explicit Sub RemovingDuplicate () 'Declaring variables Dim i As Long' Inaktivera skärmuppdateringar Application.ScreenUpdating = Falskt intervall ("A11"). Välj ActiveSheet.Sort.SortFields.Clear 'Sortera data i stigande ordning ActiveSheet.Sort.SortFields.Add Nyckel: = 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. Applicera Sluta med 'Looping through all the celler For i = ActiveSheet.Cells (Rows. Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Step -1 'Jämförelse av värde för två intilliggande celler för dubblettposter Om ActiveSheet.Cells (i, Selection.Column) .Value = ActiveSheet.Cells ( (i - 1), Selection.Column) .Värde Sedan 'Radera duplikatposten ActiveSheet.Rows (i) .Delete shift: = xlUp End If Next i' Aktiverar skärmen upp dates Application.ScreenUpdating = True End Sub
Om du gillade den här bloggen, dela den med dina vänner på Facebook. Du kan också följa oss på Twitter och Facebook.
Vi vill gärna höra från dig, låt oss veta hur vi kan förbättra vårt arbete och göra det bättre för dig. Skriv till oss på e -postwebbplatsen