如何在excel根据某个字段合并同类项，文本内容串联，数值内容求和？

在excel根据某个字段合并同类项是一个经常会碰到的问题。

如果合并同类项后，其余字段只是简单的累加或者计数或者计算平均值等，在excel中可以使用“合并计算”或者“数据透视表”功能来实现。

如果合并同类项后，其余字段还涉及字符的串联，则需要用vba来实现。

以下代码是一个通用的根据某个字段合并同类项，并且其余字段如果是文本的都串联起来，以回车换行符分隔：

Sub QQ1722187970()
    '原始数据所在工作表对象
    Dim oWKSource As Worksheet
    Set oWKSource = Sheet2
    '结果数据所在工作表对象
    Dim oWKTarget As Worksheet
    Set oWKTarget = Sheet3
    Dim oDic As Object
    Set oDic = CreateObject("Scripting.Dictionary")
    'sID表示数据源中的唯一标识列字段
    Dim sID As String
    'sItem表示对应的唯一标识列字段的行号
    Dim sItem As String
    '字典的键值数组
    Dim arrKey
    With oWKSource
        '先建立唯一标识列字段的行号索引
        For i = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
            sID = .Cells(i, "a")
            With oDic
                If .exists(sID) Then
                   sItem = .Item(sID)
                   sItem = sItem & "!" & i
                   .Item(sID) = sItem
                Else
                    .Add sID, i
                End If
            End With
        Next i
        '给目标工作表先添加列标题
        With oWKTarget
                .Cells.Clear
                arrTitle = Array("ID", "结果A", "结果B")
                iCol = UBound(arrTitle) + 1
                .Range("a1").Resize(1, iCol) = arrTitle
            End With
        arrKey = oDic.keys
        '合并同类项
        For i = 0 To UBound(arrKey)
            '唯一标识
            sID = arrKey(i)
            sItem = oDic.Item(sID)
            arr = Split(sItem, "!")
            '第一个要合并的同类项
            s1 = ""
            '第二个要合并的同类项
            s2 = ""
            For j = 0 To UBound(arr)
                iRow = arr(j)
                With oWKSource
                    If j = 0 Then
                        s1 = s1 & .Cells(iRow, "B")
                        s2 = s2 & .Cells(iRow, "C")
                    Else
                        s1 = s1 & vbCrLf & .Cells(iRow, "B")
                        s2 = s2 & vbCrLf & .Cells(iRow, "C")
                    End If
                End With
            Next j
            '输出结果
            With oWKTarget
                .Cells(i + 2, "a") = sID
                .Cells(i + 2, "b") = s1
                .Cells(i + 2, "c") = s2
            End With
        Next i
    End With
    MsgBox "操作完毕!!!"
End Sub