如何用VBA删除跨工作表重复值行（保留主数据）

以下是实现需求的VBA代码，核心逻辑是基于主键列（默认设为A列，可自行修改）识别重复值，先保留Sheet1中首次出现的主数据，删除后续重复行；同时同步删除Sheet2中对应行号的重复数据（适用于新数据粘贴到两个表相同位置的场景）。

Sub DeleteDuplicateRowsAcrossSheets()
    Dim wsMain As Worksheet, wsNew As Worksheet
    Dim lastRowMain As Long
    Dim i As Long
    Dim keyCol As String
    Dim keyDict As Object
    Dim rowsToDelete As Collection
    
    ' 初始化工作表对象，可根据实际表名修改
    Set wsMain = ThisWorkbook.Worksheets("Sheet1")
    Set wsNew = ThisWorkbook.Worksheets("Sheet2")
    ' 设置重复判断的主键列（比如B列就改为"B"）
    keyCol = "A"
    ' 创建字典存储首次出现的主键
    Set keyDict = CreateObject("Scripting.Dictionary")
    ' 创建集合存储待删除的行号
    Set rowsToDelete = New Collection
    
    ' --------------------------
    ' 标记Sheet1中需删除的重复行（后出现的）
    ' --------------------------
    lastRowMain = wsMain.Cells(wsMain.Rows.Count, keyCol).End(xlUp).Row
    
    ' 从上到下遍历，记录首次主键，标记后续重复行
    For i = 1 To lastRowMain
        Dim mainKey As Variant
        mainKey = wsMain.Cells(i, keyCol).Value
        
        If Not IsEmpty(mainKey) Then
            If keyDict.Exists(mainKey) Then
                ' 重复行，加入待删除集合
                rowsToDelete.Add i
            Else
                ' 首次出现的主键，存入字典
                keyDict.Add mainKey, i
            End If
        End If
    Next i
    
    ' --------------------------
    ' 批量删除Sheet1和Sheet2的对应行
    ' --------------------------
    ' 从大到小删除，避免行号错乱
    For i = rowsToDelete.Count To 1 Step -1
        Dim rowNum As Long
        rowNum = rowsToDelete(i)
        ' 删除Sheet1的重复行
        wsMain.Rows(rowNum).Delete
        ' 删除Sheet2的对应行（判断行号是否有效）
        If rowNum <= wsNew.Cells(wsNew.Rows.Count, keyCol).End(xlUp).Row Then
            wsNew.Rows(rowNum).Delete
        End If
    Next i
    
    ' 释放对象
    Set keyDict = Nothing
    Set rowsToDelete = Nothing
    Set wsMain = Nothing
    Set wsNew = Nothing
    
    MsgBox "重复行删除完成！", vbInformation
End Sub

使用步骤 #

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器；
2. 右键点击左侧工作簿名称 → 插入 → 模块；
3. 将上述代码粘贴到模块空白处；
4. 修改代码中的keyCol = "A"为你实际用来判断重复的列；
5. 按下F5运行宏，或者在Excel界面通过「开发工具」→「宏」选择DeleteDuplicateRowsAcrossSheets执行。

注意事项 #

• 运行前请务必备份文件，防止误删数据；
• 若Sheet1和Sheet2的行号不对应（新数据粘贴位置不同），可将Sheet2的删除逻辑改为基于主键匹配，替换对应代码段即可：

  ' 替换原Sheet2删除部分的代码
  Dim lastRowNew As Long, newKey As Variant
  lastRowNew = wsNew.Cells(wsNew.Rows.Count, keyCol).End(xlUp).Row
  ' 从下往上遍历Sheet2，删除主键对应Sheet1重复行的数据
  For i = lastRowNew To 1 Step -1
      newKey = wsNew.Cells(i, keyCol).Value
      If Not IsEmpty(newKey) Then
          ' 若主键在Sheet1中存在，但不属于首次出现的主数据，则删除
          If keyDict.Exists(newKey) And wsMain.Cells(keyDict(newKey), keyCol).Value = newKey Then
              ' 额外判断：如果Sheet2的该行数据与Sheet1重复行一致（可根据需求调整）
              If wsMain.Cells(keyDict(newKey), keyCol).EntireRow.Value = wsNew.Cells(i, keyCol).EntireRow.Value Then
                  wsNew.Rows(i).Delete
              End If
          End If
      End If
  Next i
  

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