Jak używać przykładów makr do usuwania zduplikowanych elementów na liście w programie Excel

Więcej informacji

Firma Microsoft podaje przykłady programowania tylko dla celów ilustracyjnych, nie udzielając żadnej rękojmi, wyrażonej wprost ani dorozumianej, w tym także, ale nie tylko, dorozumianej rękojmi co do przydatności handlowej lub do określonych celów. W tym artykule zakłada się, że czytelnik zna demonstrowany język programowania oraz narzędzia używane do tworzenia i debugowania procedur. Wykwalifikowani pracownicy pomocy technicznej firmy Microsoft mogą pomóc w wyjaśnieniu, jak działa określona procedura, ale nie będą modyfikować tych przykładów ani dodawać żadnych funkcji i konstruować nowych procedur w celu dostosowania ich do określonych potrzeb użytkownika.

Przykład 1. Usuwanie zduplikowanych elementów na jednej liście

Następujące przykładowe makro wyszukuje pojedynczą listę w zakresie A1:A100 i usuwa wszystkie zduplikowane elementy na liście. To makro wymaga, aby nie mieć pustych komórek w zakresie listy. Jeśli lista zawiera puste komórki, posortuj dane w kolejności rosnącej, aby puste komórki znajdowały się na końcu listy. 

    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

Przykład 2. Porównanie dwóch list i usuwanie zduplikowanych elementów

Poniższe przykładowe makro porównuje jedną listę (główną) z inną listą i usuwa zduplikowane elementy na drugiej liście, które również znajdują się na liście głównej. Pierwsza lista znajduje się w arkuszu Sheet1 w zakresie A1:A10. Druga lista znajduje się w arkuszu Sheet2 w zakresie A1:A100. Aby użyć makra, wybierz dowolny arkusz, a następnie uruchom makro. 

    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