求助：用VBA实现多工作表多单元格比对及重复行删除

刚好做过类似的需求，给你一段高效的VBA代码，完美解决你说的场景：当Sheet1的A、B列内容和Sheet2的A、B列完全一致时，删除Sheet2中对应的行。

完整代码 #

Sub DeleteMatchingRows()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim matchDict As Object
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long
    Dim key As String
    
    ' 定义要操作的工作表，注意名称要和你的实际表名一致
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    Set matchDict = CreateObject("Scripting.Dictionary")
    
    ' 先把Sheet1的A+B列组合存入字典，作为匹配依据
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow1 ' 假设第1行是表头，从第2行开始读取数据
        ' 把A、B列内容拼接成唯一键值，避免单独比对两列的麻烦
        key = Trim(ws1.Cells(i, "A").Value) & "|" & Trim(ws1.Cells(i, "B").Value)
        If Not matchDict.Exists(key) Then
            matchDict.Add key, True
        End If
    Next i
    
    ' 遍历Sheet2，从下往上删除匹配的行（从上往下删会导致行号错乱）
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    For i = lastRow2 To 2 Step -1 ' 同样假设第1行是表头
        key = Trim(ws2.Cells(i, "A").Value) & "|" & Trim(ws2.Cells(i, "B").Value)
        If matchDict.Exists(key) Then
            ws2.Rows(i).Delete
        End If
    Next i
    
    MsgBox "重复行删除完成！", vbInformation
End Sub

代码说明&注意事项 #

• 字典的作用：用字典存储Sheet1的匹配组合，比嵌套循环比对效率高太多，数据量大的时候尤其明显
• 从下往上删行：如果从上到下删除，删除一行后下面的行会上移，导致后续行的索引出错，所以必须倒序遍历
• 表头处理：代码默认第1行是表头，如果你没有表头，把i = 2改成i = 1就行
• 表名核对：确保你的工作表名称就是Sheet1和Sheet2，如果不是，修改代码里的工作表名称
• 备份文件：运行宏前最好先备份文件，防止误删数据

比如你提到的示例场景里，Sheet2的第2行和第4行A、B列与Sheet1完全匹配，运行这段代码后就会自动删掉这两行，完全符合你的需求。

内容的提问来源于stack exchange，提问作者Kyle