Tässä artikkelissa luomme makron, joka poistaa päällekkäiset tietueet tiedoista.
Raakatiedot koostuvat työntekijöiden tiedoista, jotka sisältävät nimen, iän ja sukupuolen.
Looginen selitys
Olemme luoneet makron "RemovingDuplicate" poistamaan päällekkäiset tietueet tiedoista. Tämä makro hankkii ensin tiedot peräkkäin ja vertaa sitten kahden peräkkäisen rivin arvoja löytääkseen päällekkäiset tietueet.
Koodin selitys
ActiveSheet.Sort.SortFields.Clear
Yllä olevaa koodia käytetään poistamaan tietojen aiempi lajittelu.
ActiveSheet.Sort.SortFields.Add -avain: = Range (Selection.Address), _
SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers
Yllä olevaa koodia käytetään ensimmäisen sarakkeen tietojen lajitteluun nousevassa järjestyksessä.
I = ActiveSheet.Cells (Rows.Count, Selection.Column) .End (xlUp) .Row to Selection.Row + 1 Vaihe -1
Yllä olevaa koodia käytetään käänteiseen silmukointiin, alkaen viimeisestä rivistä valittuun riviin.
ActiveSheet. Rivit (i). Poista siirto: = xlUp
Yllä olevaa koodia käytetään rivin poistamiseen ja kohdistimen siirtämiseen yläriville.
Seuraa koodia alla
Option Explicit Sub RemovingDuplicate () 'Declaring muuttujat Dim i As Long' Näytön päivitysten poistaminen käytöstä Application.ScreenUpdating = False Range ("A11"). Valitse ActiveSheet.Sort.SortFields.Clear 'Lajittele tiedot nousevassa järjestyksessä ActiveSheet.Sort.SortFields.Add Avain: = Alue (Selection.Address), _ SortOn: = xlSortOnValues, Order: = xlAscending, DataOption: = xlSortTextAsNumbers 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 solut For i = ActiveSheet .Cells ( Count, Selection.Column) .End (xlUp) .Row to Selection.Row + 1 Step -1 'Kahden vierekkäisen solun arvon vertailu päällekkäisiin tietueisiin If ActiveSheet.Cells (i, Selection.Column) .Value = ActiveSheet.Cells ( (i - 1), Selection.Column) .Arvo Sitten 'Poista päällekkäinen tietue ActiveSheet.Rows (i) .Delete shift: = xlUp End If Next i' Ota näyttö käyttöön päivämäärät Application.ScreenUpdating = True End Sub
Jos pidit tästä blogista, jaa se ystävillesi Facebookissa. Voit myös seurata meitä Twitterissä ja Facebookissa.
Haluaisimme kuulla sinusta, kerro meille, kuinka voimme parantaa työtämme ja parantaa sitä sinulle. Kirjoita meille sähköpostitse