基于多列删除重复行及原行的Excel宏开发需求

需求说明 #

需要开发Excel宏，基于指定多列（示例为前3列）删除所有存在重复的行——包括原行本身。即只要某几列的组合出现多次，所有包含该组合的行都要被移除，只保留列组合唯一的行。

输入数据 #

期望输出 #

原代码问题 #

你当前的宏使用RemoveDuplicates方法，该方法默认逻辑是保留重复项的第一个实例，仅删除后续重复行，完全不符合“移除所有重复行（含原行）”的需求：

Sub RemoveDuplicatesMultipleColumns()
Dim dataRange As Range
Set dataRange = Range("A1:D8")
dataRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End Sub

解决方案 #

方案1：辅助列统计法（直观易理解） #

通过添加辅助列计算指定列组合的出现次数，筛选并删除次数大于1的行：

Sub RemoveAllDuplicateRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim helperCol As Integer
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    helperCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1 ' 取第一个空列当辅助列
    
    ' 给辅助列加标题和重复次数公式
    ws.Cells(1, helperCol).Value = "重复次数"
    ws.Cells(2, helperCol).Formula = "=COUNTIFS($A:$A,$A2,$B:$B,$B2,$C:$C,$C2)"
    ws.Range(ws.Cells(2, helperCol), ws.Cells(lastRow, helperCol)).FillDown
    
    ' 筛选重复次数>1的行并删除
    ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, helperCol)).AutoFilter Field:=helperCol, Criteria1:=">1"
    ws.Rows("2:" & lastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    
    ' 关闭筛选并删掉辅助列
    ws.AutoFilterMode = False
    ws.Columns(helperCol).Delete
End Sub

方案2：字典法（高效处理大数据） #

用VBA字典记录列组合的出现次数，倒序遍历删除重复组合的所有行（避免行号错乱）：

Sub RemoveAllDuplicatesWithDictionary()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim key As String
    Dim dict As Object
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 第一次遍历：统计各列组合的出现次数
    For i = 2 To lastRow
        key = ws.Cells(i, 1).Value & "|" & ws.Cells(i, 2).Value & "|" & ws.Cells(i, 3).Value
        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict(key) = 1
        End If
    Next i
    
    ' 第二次遍历：从下往上删，避免行号变动影响遍历
    For i = lastRow To 2 Step -1
        key = ws.Cells(i, 1).Value & "|" & ws.Cells(i, 2).Value & "|" & ws.Cells(i, 3).Value
        If dict(key) > 1 Then
            ws.Rows(i).Delete
        End If
    Next i
End Sub

注意事项 #

• 两种方法都默认数据从A1开始，表头在第一行
• 如果需要调整判断重复的列，修改组合key的列索引即可（比如要加入第4列，就追加& "|" & ws.Cells(i,4).Value）
• 字典法处理大数据量时效率更高，辅助列法更直观，适合新手理解

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