VBA实现Excel指定列去重并按组合汇总数据求助

原代码的核心问题 #

• 偏移量计算错误：原代码中列偏移数完全不符合K、P、Q、T、U、V的位置关系，甚至超出了数据范围（如Offset(0,12)）
• 唯一组合逻辑错误：错误地将单个列值加入集合，而非目标列的组合，导致集合存储内容混乱
• SumIf引用错误：引用了不存在的列（dataRange.Columns(15)），且未正确关联O列的汇总逻辑
• 数组结构与输出逻辑错误：输出数组的结构与需求不匹配，无法正确展示唯一组合和汇总值

修正后的VBA代码 #

Sub SummarizeUniqueCombinedData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim uniqueDict As Object
    Dim i As Long
    Dim key As String
    Dim sumVal As Double
    
    ' 初始化源工作表
    Set wsSource = ThisWorkbook.Sheets("TimeRegistrations_Billable")
    ' 获取数据最后一行（以K列为基准）
    lastRow = wsSource.Range("K" & wsSource.Rows.Count).End(xlUp).Row
    
    ' 读取目标列数据到数组（提高效率）
    ' 数组对应：K(11), P(16), Q(17), T(20), U(21), V(22), O(15)
    dataArr = wsSource.Range("A2:V" & lastRow).Value
    
    ' 创建字典存储唯一组合及对应O列汇总值
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历数据行
    For i = 1 To UBound(dataArr)
        ' 拼接K、P、Q、T、U、V列作为唯一键，用|分隔避免值拼接冲突
        key = dataArr(i, 11) & "|" & dataArr(i, 16) & "|" & dataArr(i, 17) & "|" & _
              dataArr(i, 20) & "|" & dataArr(i, 21) & "|" & dataArr(i, 22)
        
        ' 处理空值避免无效键
        If key <> "||||||" Then
            ' 累加O列值
            sumVal = uniqueDict(key) + dataArr(i, 15)
            uniqueDict(key) = sumVal
        End If
    Next i
    
    ' 创建新工作表作为输出目标
    Set wsTarget = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsTarget.Name = "SummaryResult"
    
    ' 写入表头
    wsTarget.Range("A1:F1") = Array("K列", "P列", "Q列", "T列", "U列", "V列")
    wsTarget.Range("G1") = "O列汇总值"
    
    ' 写入唯一组合及汇总数据
    i = 2
    For Each key In uniqueDict.Keys
        ' 拆分键值到对应列
        wsTarget.Range("A" & i & ":F" & i) = Split(key, "|")
        ' 写入汇总值
        wsTarget.Range("G" & i) = uniqueDict(key)
        i = i + 1
    Next key
    
    ' 自动调整列宽
    wsTarget.UsedRange.Columns.AutoFit
End Sub

代码说明 #

• 高效数据读取：将数据一次性读入数组，比逐个单元格读取速度更快
• 字典存储唯一组合：用Scripting.Dictionary替代集合，更方便存储唯一键和对应的汇总值，无需错误处理
• 准确列索引：Excel列索引从1开始，K是第11列、P是第16列、Q是第17列、T是第20列、U是第21列、V是第22列、O是第15列，确保引用准确
• 冲突避免：用|分隔拼接的列值，避免不同列的内容拼接后产生重复键
• 清晰输出：写入表头并自动调整列宽，结果结构直观易读

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