Použití příkladů maker k odstranění duplicitních položek v seznamu v Excelu
Další informace
Společnost Microsoft poskytuje ukázky programování pouze pro ilustraci, bez žádné záruky výslovně uvedené nebo odvozené, včetně, bez omezení, odvozených záruk vztahujících se k obchodovatelnosti nebo vhodnosti pro určitý účel. Tento článek předpokládá, že uživatel je obeznámen s programovacím jazykem, který je předmětem ukázky, a s nástroji použitými pro vytvoření a ladění skriptu. Pracovníci technické podpory společnosti Microsoft mohou vysvětlit funkce určitého postupu, nemohou však následující příklady rozšířit o další funkce nebo konstrukce podle konkrétních požadavků uživatele.
Ukázka 1: Odstranění duplicitních položek v jednom seznamu
Následující ukázkové makro vyhledá jeden seznam v oblasti A1:A100 a odstraní všechny duplicitní položky v seznamu. Toto makro vyžaduje, abyste v oblasti seznamu neměli prázdné buňky. Pokud seznam obsahuje prázdné buňky, seřaďte data vzestupně tak, aby prázdné buňky byly na konci seznamu.
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
Ukázka 2: Porovnání dvou seznamů a odstranění duplicitních položek
Následující ukázkové makro porovná jeden (hlavní) seznam s jiným seznamem a odstraní duplicitní položky ve druhém seznamu, které jsou také v hlavním seznamu. První seznam je na listu List1 v oblasti A1:A10. Druhý seznam je na listu List2 v oblasti A1:A100. Makro použijete tak, že vyberete jeden list a pak makro spustíte.
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