多列匹配下Excel重复行检测与删除的VBA代码调整需求

针对你要处理45000行数据的需求，原代码的单列CountIf判断逻辑不仅不符合多列匹配的要求，而且处理大数量级数据时会非常慢。我给你调整了一套高效的方案，用字典来快速识别重复行，同时满足A-O列全匹配才判定重复、删除非白色行的要求，具体如下：

调整后的完整VBA代码 #

Sub DeleteDuplicateRows_MultiColumn_ColorCondition()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim uniqueDict As Object
    Dim keyStr As String
    Dim rowsToDelete As Range
    
    ' 设置目标工作表，改成你实际的表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取数据最后一行（基于A列定位）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 初始化字典，用来记录已经出现过的行组合
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    ' 关闭屏幕更新和事件，大幅提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 从最后一行往前遍历，避免删除行导致的索引错乱
    For i = lastRow To 2 Step -1
        ' 生成A-O列的组合键，用|分隔防止值拼接冲突
        keyStr = ""
        For j = 1 To 15 ' 1对应A列，15对应O列
            keyStr = keyStr & "|" & ws.Cells(i, j).Value
        Next j
        
        ' 如果这个行组合已经存在，说明是重复行
        If uniqueDict.Exists(keyStr) Then
            ' 检查当前行底色是否不是白色（ColorIndex≠0）
            If ws.Cells(i, 1).Interior.ColorIndex <> 0 Then
                ' 收集要删除的行，批量删除比逐行删高效太多
                If rowsToDelete Is Nothing Then
                    Set rowsToDelete = ws.Rows(i)
                Else
                    Set rowsToDelete = Union(rowsToDelete, ws.Rows(i))
                End If
            End If
        Else
            ' 第一次出现的行组合，存入字典
            uniqueDict.Add keyStr, i
        End If
    Next i
    
    ' 一次性删除所有符合条件的行
    If Not rowsToDelete Is Nothing Then
        rowsToDelete.Delete
    End If
    
    ' 恢复Excel的正常设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "重复行删除完成！", vbInformation
End Sub

关键优化点说明 #

• 字典去重逻辑：用字典存储A-O列的组合字符串作为唯一标识，判断重复的速度极快，处理45000行数据基本不会卡顿
• 批量删除：先把所有要删除的行收集到一个Range对象里，最后一次性删除，避免了逐行删除时Excel反复重绘的性能损耗
• 反向遍历：从最后一行往第一行遍历，就算中间删除了行，也不会影响未遍历的行的索引位置
• 分隔符防冲突：用|作为列值的分隔符，避免不同列的值拼接后产生歧义（比如A列是"AB"、B列是"C"，和A列"A"、B列"BC"的拼接结果会被正确区分）
• 性能开关：关闭屏幕更新和事件触发，减少Excel后台的额外操作，进一步提升速度

使用注意事项 #

• 如果你的数据没有表头，把遍历的起始行从2改成1即可
• 若需要精确判断白色（比如某些自定义白色的ColorIndex不是0），可以把颜色判断改成ws.Cells(i,1).Interior.Color = RGB(255,255,255)
• 代码里用CreateObject创建字典，不需要额外添加引用，直接就能运行

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