Excel VBA实现两列值匹配时合并Quantity列数值

核心思路 #

利用Scripting.Dictionary的键唯一性，以食材名+计量单位的组合作为唯一键，自动记录并累加对应数量，最后将汇总结果输出到新工作表（避免修改原数据），效率远高于手动循环比对。

完整VBA代码 #

Sub CombineIngredients()
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim ingredient As String
    Dim measure As String
    Dim key As String
    Dim quantity As Double
    Dim dict As Object
    
    ' 创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    ' 指定源数据所在工作表（可替换为具体表名如Sheet1）
    Set wsSource = ActiveSheet
    ' 新建结果工作表
    Set wsResult = ThisWorkbook.Worksheets.Add(After:=wsSource)
    wsResult.Name = "合并清单"
    
    ' 复制表头到结果表
    wsSource.Rows(1).Copy Destination:=wsResult.Rows(1)
    
    ' 获取源数据最后一行行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源数据（从第2行开始跳过表头）
    For i = 2 To lastRow
        ingredient = Trim(wsSource.Cells(i, "A").Value)
        measure = Trim(wsSource.Cells(i, "C").Value)
        quantity = wsSource.Cells(i, "B").Value ' 若Quantity不在B列，修改此处列标识
        
        ' 生成唯一键：用|分隔避免歧义
        key = ingredient & "|" & measure
        
        ' 更新字典中的数量
        If dict.Exists(key) Then
            dict(key) = dict(key) + quantity
        Else
            dict(key) = quantity
        End If
    Next i
    
    ' 将字典数据写入结果表
    Dim resultRow As Long
    resultRow = 2
    Dim dictKey As Variant
    For Each dictKey In dict.Keys
        Dim keyParts As Variant
        keyParts = Split(dictKey, "|")
        wsResult.Cells(resultRow, "A").Value = keyParts(0)
        wsResult.Cells(resultRow, "B").Value = dict(dictKey)
        wsResult.Cells(resultRow, "C").Value = keyParts(1)
        resultRow = resultRow + 1
    Next dictKey
    
    ' 自动调整列宽
    wsResult.Columns.AutoFit
    
    ' 释放对象
    Set dict = Nothing
    Set wsSource = Nothing
    Set wsResult = Nothing
    
    MsgBox "合并完成，结果已保存到「合并清单」工作表", vbInformation
End Sub

代码说明 #

• 键的设计：用|分隔食材名和计量单位，避免类似"Apple"&"Pie"与"ApplePie"&""被误判为同一组合。
• 数据位置适配：如果你的Quantity列不是B列，将wsSource.Cells(i, "B").Value替换为对应列的标识（如D列写"D"或数字4）。
• 结果安全性：默认将汇总结果写入新工作表，保留原数据完整，若需要覆盖原数据，可修改代码直接写入源表（建议先备份原数据）。

使用步骤 #

1. 打开目标Excel文件，按Alt + F11打开VBA编辑器。
2. 右键点击工程窗口中的工作簿名称 → 插入 → 模块。
3. 将上述代码粘贴到模块中。
4. 返回Excel界面，按Alt + F8，选择CombineIngredients宏执行。

低效率替代方案（循环比对） #

如果对字典不熟悉，可使用嵌套循环直接修改原数据（数据量大时会卡顿，执行前务必备份）：

Sub CombineIngredients_Loop()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从下往上遍历，避免删除行导致索引混乱
    For i = lastRow To 2 Step -1
        For j = i - 1 To 2 Step -1
            If Trim(ws.Cells(i, "A").Value) = Trim(ws.Cells(j, "A").Value) And _
               Trim(ws.Cells(i, "C").Value) = Trim(ws.Cells(j, "C").Value) Then
                ws.Cells(j, "B").Value = ws.Cells(j, "B").Value + ws.Cells(i, "B").Value
                ws.Rows(i).Delete
                Exit For
            End If
        Next j
    Next i
    
    MsgBox "合并完成", vbInformation
End Sub

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