首页 > 解决方案 > VBA Excel:枚举重复的总数。计数和总和

问题描述

图片

左边是假设的数据库。右边是我想要得到的结果。我想打印 B 类型的所有项目,以及总和和计数。我被卡住了,我无法继续前进。你能帮帮我吗?谢谢。

Private Sub CommandButton1_Click()

Dim dicDistincts As Scripting.Dictionary, _
    dicDuplicates As Scripting.Dictionary
Set dicDistincts = New Scripting.Dictionary
Set dicDuplicates = New Scripting.Dictionary

Dim i As Integer

For i = 2 To 10
    If Cells(i, 1).Value = "B" Then
        If Not dicDistincts.Exists(Cells(i, 2).Value) Then
        
            dicDistincts.Add Key:=Cells(i, 2).Value, Item:=Cells(i, 2).Value
        Else
        
            dicDuplicates.Add Key:=Cells(i, 2).Value, Item:=Cells(i, 2).Value
        End If
    End If
Next i

For i = 0 To dicDuplicates.Count - 1
    Cells(i + 1, 9).Value = WorksheetFunction.CountIfs(Range("a2:a10"), "B", Range("b2:b10"), dicDistincts.keys(i))
Next i

End Sub

编辑:我尝试使用 countifs,但香蕉、苹果和草莓返回 0

编辑 2:我更正了计数。现在它起作用了。

标签: excelvba

解决方案


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

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

推荐阅读