VBA多列去重汇总需求：需扩展代码支持A/B/E列去重、C/D列求和

要实现A、B、E列联合去重，同时对C、D列按唯一键汇总，不能直接依赖Excel原生的RemoveDuplicates方法（它只会保留重复组的第一行，无法自动汇总），以下是用字典实现的完整解决方案：

完整代码 #

Sub AdvancedDedupeAndSum()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim key As String
    Dim i As Long
    Dim outputRow As Long
    
    ' 绑定目标工作表（可改为指定工作表名，比如Sheets("数据")）
    Set ws = ThisWorkbook.ActiveSheet
    ' 获取数据区域最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典存储唯一键与对应C、D列的汇总值
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历所有数据行（假设第1行是表头，从第2行开始处理）
    For i = 2 To lastRow
        ' 生成A/B/E列的联合唯一键，用|分隔避免内容拼接冲突
        key = ws.Cells(i, "A").Value & "|" & ws.Cells(i, "B").Value & "|" & ws.Cells(i, "E").Value
        
        If dict.Exists(key) Then
            ' 键已存在，累加C、D列的值
            dict(key)(0) = dict(key)(0) + ws.Cells(i, "C").Value
            dict(key)(1) = dict(key)(1) + ws.Cells(i, "D").Value
        Else
            ' 键不存在，新增记录并初始化C、D列值
            dict.Add key, Array(ws.Cells(i, "C").Value, ws.Cells(i, "D").Value)
        End If
    Next i
    
    ' 清空原数据区域（保留表头）
    ws.Range("A2:E" & lastRow).ClearContents
    
    ' 将字典中的结果写入工作表
    outputRow = 2
    For Each key In dict.Keys
        ' 拆分唯一键，写入A、B、E列
        ws.Cells(outputRow, "A").Value = Split(key, "|")(0)
        ws.Cells(outputRow, "B").Value = Split(key, "|")(1)
        ws.Cells(outputRow, "E").Value = Split(key, "|")(2)
        ' 写入汇总后的C、D列数值
        ws.Cells(outputRow, "C").Value = dict(key)(0)
        ws.Cells(outputRow, "D").Value = dict(key)(1)
        outputRow = outputRow + 1
    Next key
    
    ' 释放对象
    Set dict = Nothing
    Set ws = Nothing
    
    MsgBox "去重汇总完成！"
End Sub

关键修改说明 #

1. 联合唯一键生成：用|作为分隔符拼接A、B、E列内容，避免不同组合的内容拼接后产生重复键（比如A列"AB"+B列"C" 和 A列"A"+B列"BC"的情况）
2. 字典汇总逻辑：每个唯一键对应一个数组，分别存储C、D列的累计值，遍历数据时自动累加
3. 结果写入：清空原数据后，将字典中的唯一键和汇总值逐行写入，确保最终数据只保留唯一组合和汇总结果

自定义调整点 #

• 如果你的汇总需求不是求和（比如求平均值、最大值），可修改累加代码：
  • 求最大值：dict(key)(0) = Application.Max(dict(key)(0), ws.Cells(i, "C").Value)
  • 求平均值：需要额外存储计数，比如用二维数组记录总和与数量，最后做除法
• 如果表头不在第1行，将循环起始行For i = 2 To lastRow中的2改为数据起始行号

内容的提问来源于stack exchange，提问作者90'sProSkater