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

Sub CountAndSumDuplicates()
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
    Dim countDict As Object
    Dim sumDict As Object
    
    Set rng = Range("A1:A10") '假设要统计的数据范围是A1到A10
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set countDict = CreateObject("Scripting.Dictionary")
    Set sumDict = CreateObject("Scripting.Dictionary")
    
    '遍历数据范围，将重复项的值作为键，出现次数作为值存入字典
    For Each cell In rng
        If dict.exists(cell.Value) Then
            dict(cell.Value) = dict(cell.Value) + 1
            sumDict(cell.Value) = sumDict(cell.Value) + cell.Value
        Else
            dict.Add cell.Value, 1
            sumDict.Add cell.Value, cell.Value
        End If
    Next cell
    
    '输出重复项的总数、计数和求和结果
    For Each key In dict.keys
        Debug.Print "值为 " & key & " 的重复项总数为 " & dict(key)
        Debug.Print "值为 " & key & " 的重复项计数为 " & countDict(key)
        Debug.Print "值为 " & key & " 的重复项求和为 " & sumDict(key)
    Next key
End Sub