指定したセル範囲をDictionaryに格納する(Itemを合計する)【ExcelVBA】

'参照設定　Microsoft Scripting Runtime
Public Function RangeToDictionary(rng As Range, col As Long) As dictionary
    Dim dic As dictionary
    Set dic = New dictionary
     
    Dim rCell As Range
     
    Dim i As Long
    
    For i = rng.Row To rng.Row + rng.Rows.Count - 1
        If Cells(i, rng.Column) <> "" Then
            '■Keyは指定範囲のセルの一番左側、Itemはcolで指定したColumn(Exists=Falseなら新規作成、Trueなら値を足す)
            If dic.Exists(Cells(i, rng.Column).Value) = False Then
                dic.Add Cells(i, rng.Column).Value, Cells(i, rng.Column).Offset(0, col - 1)
            Else
                dic(Cells(i, rng.Column).Value) = dic(Cells(i, rng.Column).Value) + Cells(i, rng.Column).Offset(0, col - 1)
            End If
        End If
    Next i
    
    If dic.Count <> 0 Then
       Set RangeToDictionary = dic
    End If
End Function

'■任意のセル範囲をDictionaryに格納する(結果をDictionaryで合計値を受け取る)
Public Sub sample()
    Dim arr As dictionary
    
    Range("A1:C1").Value = "a"
    Range("A2:C2").Value = "a"
    Range("A3:C3").Value = "a"
    Range("A4:C4").Value = "b"
    Range("A5:C5").Value = "c"
    Range("D1:E5").Value = 1000
    
    Set arr = RangeToDictionary(Range("A1:E5"), 4) 'A列から4列目のD列のデータをItemに格納
    
    Debug.Print arr.Count        '3(a,b,cの合計3)
    Debug.Print arr.Items(0)     '3000
    Debug.Print arr.Items(1)     '1000
    Debug.Print arr.Items(2)     '1000


End Sub