概要:在 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 = To xRow
For j = i + To xRow
If Cells(j, ) = Cells(i, ) Then
Range(Cells(j, ), Cells(j, )).Rows.Delete
j = j -
xRow = xRow -
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 = 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, ).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, ).Value Then
' If match is true then delete row.
Sheets("Sheet1").Cells(iCtr, ).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr +
End If
End If
Next iCtr
' Go to next record.
ActiveCell.Offset(, ).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 = 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, ).Value Then
' If match is true then delete row.
Sheets("Sheet2").Cells(iCtr, ).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr +
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub