在 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