如何使用Excel VBA实现文本合并与金额求和？

针对你的需求——按Date、Name、Type三个字段合并重复行，并对Amount求和，这里给你两种可行的方案，重点推荐用**字典（Dictionary）**实现的VBA代码，逻辑清晰且效率较高：

方法一：使用VBA字典实现分组求和 #

字典是VBA里处理这类分组统计的利器，它可以通过唯一的"键"来关联对应的值，正好匹配我们按多字段分组的需求。

完整代码 #

Sub CombineAndSum()
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Object
    Dim key As String
    Dim amount As Double
    
    ' 设置源工作表和结果工作表（可根据实际修改）
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    On Error Resume Next
    Set wsResult = ThisWorkbook.Sheets("Sheet2")
    If Err.Number <> 0 Then
        Set wsResult = ThisWorkbook.Sheets.Add(After:=wsSource)
        wsResult.Name = "Sheet2"
    End If
    On Error GoTo 0
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 获取源数据的最后一行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源数据（从第2行开始，跳过表头）
    For i = 2 To lastRow
        ' 组合唯一键：用特殊字符分隔三个字段，避免字段内容重叠导致键重复
        key = wsSource.Cells(i, "A").Value & "|" & wsSource.Cells(i, "B").Value & "|" & wsSource.Cells(i, "C").Value
        amount = wsSource.Cells(i, "D").Value
        
        ' 判断键是否已存在：存在则累加金额，不存在则新增
        If dict.Exists(key) Then
            dict(key) = dict(key) + amount
        Else
            dict(key) = amount
        End If
    Next i
    
    ' 清空结果表已有内容，写入表头
    wsResult.Cells.Clear
    wsSource.Range("A1:D1").Copy Destination:=wsResult.Range("A1")
    
    ' 将字典中的结果写入结果表
    Dim item As Variant
    Dim rowNum As Long
    rowNum = 2
    For Each item In dict.Keys
        ' 拆分键，还原三个字段
        Dim keyParts As Variant
        keyParts = Split(item, "|")
        wsResult.Cells(rowNum, "A").Value = keyParts(0)
        wsResult.Cells(rowNum, "B").Value = keyParts(1)
        wsResult.Cells(rowNum, "C").Value = keyParts(2)
        wsResult.Cells(rowNum, "D").Value = dict(item)
        rowNum = rowNum + 1
    Next item
    
    ' 自动调整结果表列宽
    wsResult.Columns.AutoFit
    
    MsgBox "合并求和完成！", vbInformation
End Sub

代码说明 #

• 自动创建结果表：如果没有Sheet2，代码会自动新增工作表并命名
• 键的组合：用|分隔三个字段，确保不同的组合生成唯一的键，避免因为字段内容包含空格等导致的冲突
• 字典操作：Exists方法判断分组是否已存在，存在则累加金额，不存在则初始化
• 结果输出：拆分键还原原始字段，写入新工作表，避免覆盖源数据

使用注意事项 #

1. 确保你的源数据在Sheet1，表头在第1行，四个字段分别对应A-D列
2. 如果Amount列有非数值内容，代码会报错，建议先确保该列都是数字

方法二：用Excel透视表快速实现（非VBA） #

如果你不需要用代码，也可以手动用透视表一键完成：

• 选中源数据区域，点击「插入」→「数据透视表」
• 把Date、Name、Type拖到「行」区域，Amount拖到「值」区域，值字段设置为「求和」
• 调整透视表布局即可得到你要的结果

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