使用字典汇总数据

Sub SumIt()
    Dim ar
    Dim i As Long
    Dim arr As Variant
    Dim n As Long
    ar = [a1].CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar, 1)
            .Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 6)
        Next
        arr = Array(.keys, .items)
        n = .Count
    End With
    [T4].CurrentRegion.ClearContents
    [T4].Resize(n, 2).Value = Application.Transpose(arr)
End Sub

Sub SumMultiple()
    Dim ar As Variant
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim str As String
    n = 1
    ar = Cells(10, 1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(ar, 1)
            str = ar(i, 1)
            If Not .Exists(str) Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    ar(n, j) = ar(i, j)
                Next
                .Item(str) = n
            Else
                For j = 5 To UBound(ar, 2)
                    ar(.Item(str), j) = ar(.Item(str), j) + ar(i, j)
                Next
            End If
        Next
    End With
    [K4].CurrentRegion.ClearContents
    [K4].Resize(n, UBound(ar, 2)).Value = ar
End Sub