如何为高级筛选添加重复项判定规则并保留最新数据？

我有一个处理大量数据的高级筛选工具，部分数据属于同一产品，但日期或价格不同。希望高级筛选能识别产品、人员、supplier PN、MOQ均相同的重复行，对比后保留价格更新时间较新的行，删除旧重复行。

当前与期望效果 #

• 当前高级筛选显示示例：
  
• 期望的标记重复项并删除旧重复行效果示例：
  

现有实现方案的问题 #

我目前用VBA代码实现，但运行极慢，尤其是标记绿色行后删除行的阶段卡顿严重：

Dim xRow As Integer, cRow As Integer, i As Integer
xRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 12 To xRow
For cRow = i + 1 To xRow
If Range("B" & cRow) = Range("B" & i) Then
    If Range("C" & cRow) = Range("C" & i) Then
        If Range("E" & cRow) = Range("E" & i) Then
            If Range("I" & cRow) = Range("I" & i) Then
            Range("B" & cRow & ":J" & cRow).Interior.Color = vbGreen
            End If
        End If
    End If
End If
Next cRow
Next i


For Each GreenRow In Range("Search!$B$12:$B$" & Cells(Rows.Count, "B").End(xlUp).Row)
        If GreenRow.Interior.Color = vbGreen Then
            Range("B" & GreenRow.Row).Select
            Do Until ActiveCell.Interior.Color <> vbGreen
            ActiveCell.EntireRow.Delete
            Loop
        End If
Next GreenRow

关于Excel高级筛选的可行性 #

Excel原生高级筛选只能基于条件筛选数据，无法直接实现按多维度分组后自动保留最新行的去重逻辑。它可以筛选出重复项，但不支持对比时间并保留最新记录，因此需要结合辅助方法（辅助列+排序，或优化后的VBA）来实现需求。

现有VBA代码卡顿的原因及优化方案 #

卡顿核心原因 #

1. 嵌套循环遍历：双重For循环的时间复杂度为O(n²)，数据量越大耗时呈指数级增长；
2. 频繁单元格操作：每次判断都直接读写单元格，且删除行时用Select触发界面刷新，大幅拖慢速度；
3. 删除逻辑错误：Do Until循环在删除行后行号会变动，容易出现漏删或死循环，加剧卡顿。

优化后的高效VBA代码 #

Sub KeepLatestRecords()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim dateCol As String
    Dim dict As Object
    Dim key As String, currentDate As Date
    
    ' 配置参数：根据你的实际列调整
    Set ws = ThisWorkbook.Sheets("Search")
    dateCol = "K" ' 替换为你的价格更新时间所在列字母
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 禁用界面刷新和事件，大幅提升速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 用字典记录每组的最新行信息
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 从下往上遍历，避免删除行导致的行号错乱
    For i = lastRow To 12 Step -1
        ' 生成唯一标识键：组合多列判断重复
        key = ws.Cells(i, "B").Value & "|" & ws.Cells(i, "C").Value & "|" & _
              ws.Cells(i, "E").Value & "|" & ws.Cells(i, "I").Value
        currentDate = ws.Cells(i, dateCol).Value
        
        If dict.Exists(key) Then
            ' 对比日期，删除旧行
            If currentDate < ws.Cells(dict(key), dateCol).Value Then
                ws.Rows(i).Delete
            Else
                ws.Rows(dict(key)).Delete
                dict(key) = i ' 更新字典为当前最新行号
            End If
        Else
            ' 首次记录该组，保存行号
            dict(key) = i
        End If
    Next i
    
    ' 恢复界面设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "去重完成，已保留最新数据！"
End Sub

优化点说明 #

• 使用Scripting.Dictionary：通过唯一键分组，只需遍历一次数据，时间复杂度降至O(n)；
• 从下往上删除行：避免删除行后行号错乱的问题，无需额外循环判断；
• 禁用界面刷新：关闭ScreenUpdating和EnableEvents，减少Excel界面渲染开销；
• 直接操作行对象：摒弃低效的Select操作，所有操作直接在工作表对象上执行。

非VBA替代方案（适合无代码基础用户） #

1. 添加辅助列：在空白列输入公式，组合多列生成唯一标识，例如=B2&C2&E2&I2；
2. 排序：按辅助列升序排序，再按价格更新时间降序排序，让每组最新行排在最上方；
3. 删除重复项：选中数据区域，点击「数据」→「删除重复项」，仅勾选辅助列，确定后即可保留每组的最新行。

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