VBA合并相同数据行求助：文本与数字混合数据处理需求

实现逻辑 #

以DATE、DESCRIPTION、SIZE、ITEM #、SUPPLIER NAME、DELIVERY DATE作为重复判断的唯一标识组合，对标识完全一致的行，累加QTY列数值，其余文本列保留原内容。

VBA代码 #

Sub MergeDuplicateRows()
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim dict As Object
    Dim key As String
    Dim arrSource As Variant, arrResult As Variant
    
    ' 指定原始数据所在工作表（修改为你的表名）
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    ' 创建或获取结果工作表
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("合并结果")
    On Error GoTo 0
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Worksheets.Add(After:=wsSource)
        wsResult.Name = "合并结果"
    End If
    
    ' 清空结果表旧数据
    wsResult.Cells.Clear
    
    ' 读取原始数据到数组提升效率
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    arrSource = wsSource.Range("A1:G" & lastRow).Value
    
    ' 用字典存储唯一标识与对应数据
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历原始数据（跳过表头）
    For i = 2 To UBound(arrSource)
        ' 拼接唯一标识键
        key = arrSource(i, 1) & "|" & arrSource(i, 2) & "|" & arrSource(i, 3) & "|" & _
              arrSource(i, 4) & "|" & arrSource(i, 6) & "|" & arrSource(i, 7)
        
        If dict.Exists(key) Then
            ' 已存在则累加QTY
            dict(key)(4) = dict(key)(4) + arrSource(i, 5)
        Else
            ' 不存在则新增条目
            dict.Add key, Array(arrSource(i, 1), arrSource(i, 2), arrSource(i, 3), _
                               arrSource(i, 4), arrSource(i, 5), arrSource(i, 6), arrSource(i, 7))
        End If
    Next i
    
    ' 写入表头
    wsResult.Range("A1:G1").Value = wsSource.Range("A1:G1").Value
    
    ' 写入合并后的数据
    j = 2
    For Each key In dict.Keys
        arrResult = dict(key)
        wsResult.Cells(j, 1).Resize(1, 7).Value = arrResult
        j = j + 1
    Next key
    
    ' 自动调整列宽
    wsResult.Columns.AutoFit
    
    MsgBox "合并完成，结果已保存到「合并结果」工作表", vbInformation
End Sub

使用步骤 #

1. 打开目标Excel文件，按Alt + F11打开VBA编辑器
2. 右键左侧工程窗口中的当前工作簿，选择「插入」→「模块」
3. 粘贴上述代码到模块窗口
4. 修改代码中Set wsSource = ThisWorkbook.Worksheets("Sheet1")的Sheet1为你的原始数据工作表名称
5. 按F5运行宏，或回到Excel界面，通过「开发工具」→「宏」选择MergeDuplicateRows执行

注意事项 #

• 确保原始数据列顺序与示例一致：DATE(A)、DESCRIPTION(B)、SIZE(C)、ITEM #(D)、QTY(E)、SUPPLIER NAME(F)、DELIVERY DATE(G)，若列位置不同，需调整代码中数组索引（如arrSource(i, 5)对应QTY列）
• 若文本内容包含|，请替换代码中键拼接的分隔符为其他不常用符号（如^）

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