求c列各字母对应金额的总和

qwer121381

请教下大家，怎么求c列各字母对应金额的总和，一步完成，最好可以用不同方法完成，公式越多越好，谢谢

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ReDim arr(1 To Sheets.Count)
With Sheets("sheet1")
    r = .Cells(Rows.Count, 3).End(xlUp).Row
    ar = .Range("c1:d" & r)
    ReDim br(1 To UBound(ar), 1 To 2)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            t = d(Trim(ar(i, 1)))
            If t = "" Then
                k = k + 1
                d(Trim(ar(i, 1))) = k
                t = k
                br(k, 1) = ar(i, 1)
            End If
            br(t, 2) = br(t, 2) + ar(i, 2)
        End If
    Next i
    .Columns("g:h") = Empty
    .[g1].Resize(k, 2) = br
End With
MsgBox "ok!"
End Sub

3190496160

Sub 汇总2()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ReDim arr(1 To Sheets.Count)
With Sheets("sheet1")
    r = .Cells(Rows.Count, 3).End(xlUp).Row
    ar = .Range("c1:d" & r)
    ReDim br(1 To UBound(ar), 1 To 2)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = d(Trim(ar(i, 1))) + ar(i, 2)
        End If
    Next i
    .Columns("g:h") = Empty
    .[g1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End With
MsgBox "ok!"
End Sub

3190496160

两种方式

3190496160

工作簿1.rar (15.29 KB, 下载次数: 1)

2023-1-11 17:46 上传

点击文件名下载附件

xinlan55

这个SUMPRODUCT函数就搞定了啊