Ismétlődő elemek törlése az Excelben makró példák használatával
További információ
A Microsoft csak szemléltetési célból ad közre programozási példákat, és azokra sem közvetlen, sem közvetett jótállást nem vállal. Ebbe beleértendő a forgalomba hozhatóságra és az adott célra való megfelelőségre vonatkozó jótállás is. A cikk feltételezi, hogy az olvasó jártas a szemléltetésre szolgáló programozási nyelvben, valamint az eljárások létrehozására és a velük kapcsolatos hibakeresésre szolgáló eszközök használatában. A Microsoft támogatási szakemberei segítséget nyújthatnak egy-egy adott eljárás funkcionalitásának megértésében, de funkcionalitásbővítési célból nem módosítják a példákat, és nem készítenek az egyéni igényeknek megfelelő eljárásokat.
1. minta: Ismétlődő elemek törlése egyetlen listában
Az alábbi makróminta egyetlen listában keres az A1:A100 tartományban, és törli a lista összes ismétlődő elemét. Ehhez a makróhoz nincs szükség üres cellákra a listatartományban. Ha a lista üres cellákat tartalmaz, rendezze az adatokat növekvő sorrendbe, hogy az üres cellák a lista végén legyenek.
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False
' Get count of records to search through.
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Sheets("Sheet1").Range("A1").Select
' Loop until end of records.
Do Until ActiveCell = ""
' Loop through records.
For iCtr = 1 To iListCount
' Don't compare against yourself.
' To specify a different column, change 1 to the column number.
If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr + 1
End If
End If
Next iCtr
' Go to next record.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
2. minta: Két lista összehasonlítása és ismétlődő elemek törlése
Az alábbi mintamakró összehasonlítja az egyik (fő) listát egy másik listával, és törli a második lista ismétlődő elemeit, amelyek szintén szerepelnek a főlistában. Az első lista az A1:A10 tartományban lévő Munka1 lapon található. A második lista a Munka2 lapon található az A1:A100 tartományban. A makró használatához jelölje ki bármelyik munkalapot, majd futtassa a makrót.
Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False
' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count
' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:A10")
' Loop through all records in the second list.
For iCtr = 1 To iListCount
' Do comparison of next record.
' To specify a different column, change 1 to the column number.
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr + 1
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub