在 Excel 中如何使用宏示例刪除列表中的重復項

概要：在 Microsoft Excel 中，可以創建宏來刪除列表中的重復項。也可以創建宏來比較兩個列表，並刪除第二個列表中那些也出現在第一個（主）列表中的項目。如果您想將兩個列表合並在一起，或者如果只想看到新的信息，則上述做法很有用。本文包含 Microsoft Visual Basic for Applications 示例宏（Sub 過程），說明如何刪除單個列表中的重復記錄（示例 1），以及如何在比較兩個列表后刪除重復記錄（示例 2）。這些宏並不要求對列表進行排序。此外，這些宏可刪除任意數量的重復項，無論項目在列表中是重復一次還是多次。

Excal數據示例如下：

序號      圖號     名稱      數量
 1        123    氣缸蓋     10
 2        123    氣缸蓋     10
 3        456    噴油器     30

對於這段數據進行簡單處理，刪除序號1或者2其中的任何一行均可，但是要保留其中一行

Sub 刪除重復行()
    Dim xRow As Integer
    Dim i As Integer
    xRow = Range("B65536").End(xlUp).Row
    For i = 2 To xRow
        For j = i + 1 To xRow
            If Cells(j, 2) = Cells(i, 2) Then
                Range(Cells(j, 1), Cells(j, 256)).Rows.Delete
                j = j - 1
                xRow = xRow - 1
            End If
        Next
    Next
End Sub

 

輸入上述代碼，運行該代碼或運行宏“刪除重復行”即可。有個缺陷，只是判斷圖號相同即刪除，假如圖號相同、數量不同的行照樣刪除。

示例 1：刪除單個列表中的重復項

以下示例宏搜索區域 A1:A100 中的單個列表，並刪除列表中的所有重復項。此宏要求在列表區域中不能有空白單元格。如果列表確實包含空白單元格，請按升序對數據進行排序，以使空白單元格全都位於列表的末尾。

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：比較兩個列表並刪除重復項

以下示例宏將一個（主）列表與另一個列表進行比較，然后刪除第二個列表中那些也出現在主列表中的重復項。第一個列表在 Sheet1 上的區域 A1:A10 中。第二個列表在 Sheet2 上的區域 A1:A100 中。要使用此宏，請選擇任一個表，然后運行此宏。

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