VBA Excel：枚举重复的总数。计数和求和

如果您必须使用字典，那么您可以使用单个字典来完成此操作，将计数和数量作为数组存储为字典中的值。

Private Sub CommandButton1_Click()
Dim dic As Scripting.Dictionary
Dim arrData()
Dim i As Long
Dim ky As Variant

    Set dic = New Dictionary

    For i = 2 To 10
        If Cells(i,1).Value = "B" Then
            ky = Cells(i,2).Value
            If Not dic.Exists(ky) Then
                arrData = Array(1,Cells(i,3).Value)
            Else
                arrData = dic(ky)
                arrData = Array(arrData(0) + 1,arrData(1) + Cells(i,3).Value)
            End If
            dic(ky) = arrData
        End If
    Next i

    Range("A1:C1").Copy Range("E1:G1")
    For i = 0 To dic.Count - 1
        Range("E" & i + 2) = dic.Keys(i)
        Range("F" & i + 2).Resize(,2) = dic.Items(i)
    Next i

End Sub

带双字典的唯一和和唯一计数

Option Explicit

Private Sub CommandButton1_Click()

    Dim rg As Range
    With Range("A1").CurrentRegion
        Set rg = .Resize(.Rows.Count - 1).Offset(1)
    End With
    Dim Data As Variant: Data = rg.Value
    
    Dim cDict As Object: Set cDict = CreateObject("Scripting.Dictionary")
    Dim sDict As Object: Set sDict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    
    For i = 1 To UBound(Data,1)
        If Data(i,1) = "B" Then
            cDict(Data(i,2)) = cDict(Data(i,2)) + 1 ' Count
            sDict(Data(i,2)) = sDict(Data(i,2)) + Data(i,3) ' Sum
        End If
    Next i
    
    ReDim Data(1 To cDict.Count,1 To 3)
    i = 0
    
    Dim Key As Variant
    
    For Each Key In cDict.Keys
        i = i + 1
        Data(i,1) = Key
        Data(i,2) = sDict(Key)
        Data(i,3) = cDict(Key)
    Next Key
    
    With Range("E2").Resize(,3)
        .Resize(i).Value = Data
        .Resize(.Worksheet.Rows.Count - .Row - i + 1).Offset(i).ClearContents
    End With

End Sub

这应该可以工作，它使用循环遍历所有 bs 并将它们添加到另一个列表中

Sub countBs()


Dim Bs As Range 'list of the line of all Bs
Dim B As Range 'each indiviual b in the B list
Dim Item As Range 'each indivual item
Dim adder As Range 'resturns nothing if b not fond in times

Set Bs = Range("a2",Range("a2").End(xlDown)) 'you can also change this ofcourse to a specifici range or user selected


For Each B In Bs
    If B = "B" Then
        Set adder = Range("g2",Range("g2").End(xlDown)).Find(B.Offset(0,1))
        If adder Is Nothing Then
            If Range("g2") = "" Then
                Set Item = Range("g2")
            Else
                Set Item = Range("g1").End(xlDown).Offset(1,0)
            End If
            Item.Resize(1,2).Value = B.Offset(0,1).Resize(1,2).Value
            Item.Offset(0,2) = 1
        Else
            adder.Offset(0,1).Value = adder.Offset(0,1).Value + B.Offset(0,2).Value
            adder.Offset(0,2).Value = adder.Offset(0,2).Value + 1
        End If
    End If
Next B


End Sub