Excel VBA合并重复行和某些列中的求和值

Sub MergeDuplicatesAndSum()
    Dim lastRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
    
    ' 获取数据范围
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range("A1:C" & lastRow)
    
    ' 创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历数据范围
    For Each cell In rng.Rows
        ' 检查是否已存在相同的键
        If dict.exists(cell.Value) Then
            ' 如果存在，则将当前行的值累加到已存在的行
            dict(cell.Value) = dict(cell.Value) + cell.Offset(0, 2).Value
        Else
            ' 如果不存在，则添加新的键值对
            dict.Add cell.Value, cell.Offset(0, 2).Value
        End If
    Next cell
    
    ' 清空原数据范围
    rng.ClearContents
    
    ' 将合并后的数据写入原数据范围
    For Each key In dict.keys
        lastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(lastRow, 1).Value = key
        Cells(lastRow, 3).Value = dict(key)
    Next key
End Sub