În acest articol, vom crea o macro pentru a elimina înregistrările duplicate din date.
Datele brute constau în date despre angajați, care includ numele, vârsta și sexul.
Explicație logică
Am creat o macro „RemovingDuplicate” pentru a elimina înregistrările duplicate din date. Această macrocomandă în primul rând obține datele într-o secvență și apoi face o comparație între valorile a două rânduri consecutive pentru a afla înregistrări duplicate.
Explicarea codului
ActiveSheet.Sort.SortFields.Clear
Codul de mai sus este utilizat pentru a elimina orice sortare anterioară a datelor.
ActiveSheet.Sort.SortFields.Add Key: = Range (Selection.Address), _
SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers
Codul de mai sus este utilizat pentru a sorta datele din prima coloană în ordine crescătoare.
Pentru i = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row To Selection.Row + 1 Step -1
Codul de mai sus este utilizat pentru a aplica o buclă inversă, începând de la ultimul rând până la rândul selectat.
ActiveSheet.Rows (i). Ștergeți schimbarea: = xlUp
Codul de mai sus este utilizat pentru a șterge un rând și a muta cursorul pe rândul superior.
Vă rugăm să urmați codul de mai jos
Opțiune Explicit Sub RemovingDuplicate () 'Declaring variables Dim i As Long' Dezactivarea actualizărilor ecranului Application.ScreenUpdating = False Range ("A11"). Selectați ActiveSheet.Sort.SortFields.Clear 'Sortarea datelor în ordine crescătoare ActiveSheet.Sort.SortFields.Add Cheie: = Range (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers With ActiveSheet.Sort .SetRange Range (Selection.Offset (1, 0), ActiveSheet.Cells (Rows.Count, Selecție.End (xlToRight) .Column) .End (xlUp)) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin. Aplicați End With 'Looping prin toate celulele pentru 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). Valoare Apoi 'Ștergeți înregistrarea duplicat ActiveSheet.Rows (i). Ștergeți shift: = xlUp End If Next i' Activarea ecranului date Application.ScreenUpdating = Adevărat End Sub
Dacă ți-a plăcut acest blog, distribuie-l prietenilor tăi de pe Facebook. De asemenea, ne puteți urmări pe Twitter și Facebook.
Ne-ar plăcea să aflăm de la dvs., să ne anunțați cum putem îmbunătăți munca noastră și o putem îmbunătăți. Scrieți-ne pe site-ul de e-mail