如何使用Excel VBA按条件创建汇总表（合并相同ARTICLE CODE行）

核心思路 #

利用字典（Dictionary）快速匹配相同的ARTICLE CODE，将对应行的数据合并到同一行，替代冗余的数组操作逻辑。

完整VBA代码 #

Sub MergeSameArticleCode()
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long, resultRow As Long
    Dim dict As Object
    Dim articleCode As String
    
    ' 设置源工作表和结果工作表（可根据实际修改表名）
    Set wsSource = ThisWorkbook.Worksheets("数据源")
    Set wsResult = ThisWorkbook.Worksheets("汇总表")
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 清空结果表原有数据（保留表头）
    wsResult.Range("A2:" & wsResult.Cells(wsResult.Rows.Count, wsResult.Columns.Count).Address).Clear
    
    ' 获取源表最后一行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    resultRow = 2 ' 结果表从第二行开始（第一行是表头）
    
    ' 遍历源表数据，用字典记录ARTICLE CODE对应的结果行号
    For i = 2 To lastRow
        articleCode = wsSource.Cells(i, "A").Value ' 假设ARTICLE CODE在A列
        If dict.Exists(articleCode) Then
            ' 如果已存在，将当前行的数值型列累加（这里假设从B列开始是需要汇总的列）
            For col = 2 To wsSource.Cells(i, wsSource.Columns.Count).End(xlToLeft).Column
                If IsNumeric(wsSource.Cells(i, col).Value) Then
                    wsResult.Cells(dict(articleCode), col).Value = wsResult.Cells(dict(articleCode), col).Value + wsSource.Cells(i, col).Value
                Else
                    ' 非数值型列默认保留第一个值，可按需修改逻辑
                    If wsResult.Cells(dict(articleCode), col).Value = "" Then
                        wsResult.Cells(dict(articleCode), col).Value = wsSource.Cells(i, col).Value
                    End If
                End If
            Next col
        Else
            ' 如果不存在，复制整行到结果表，并记录行号到字典
            wsSource.Rows(i).Copy wsResult.Rows(resultRow)
            dict.Add articleCode, resultRow
            resultRow = resultRow + 1
        End If
    Next i
    
    ' 释放对象
    Set dict = Nothing
    Set wsSource = Nothing
    Set wsResult = Nothing
    
    MsgBox "汇总完成！"
End Sub

使用说明 #

• 确保你的源工作表名为「数据源」，结果工作表名为「汇总表」，如果不是，直接修改代码中对应的工作表名称。
• 假设ARTICLE CODE在A列，需要汇总的列从B列开始，可根据实际列位置调整代码中的列索引。
• 若需要合并非数值型列的文本，可将对应代码替换为：wsResult.Cells(dict(articleCode), col).Value = wsResult.Cells(dict(articleCode), col).Value & ", " & wsSource.Cells(i, col).Value。
• 运行前建议备份原始数据，避免意外修改。

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