指定したセル範囲をDictionaryに格納する(Keyと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 i As Long
    
    For i = rng.Row To rng.Row + rng.Rows.Count - 1
        If Cells(i, rng.Column) <> "" Then
            If dic.Exists(Cells(i, rng.Column).Value) = False Then
                '■Keyは指定範囲のセルの一番左側、Itemはcolで指定したColumn
                dic.Add 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:C5").Value = "a"
    Range("D1:E5").Value = "b"
    
    Set arr = RangeToDictionary(Range("A1:E5"), 4) 'A列から4列目のD列のデータをItemに格納
    Set arr = RangeToDictionary(Range("B1:E5"), 4) 'B列から4列目のE列のデータをItemに格納
    
    Debug.Print arr.Count        '1(セル範囲の1列目にはAのみなので1つしかdicに入らない)
    Debug.Print arr.Items(0)     'b


End Sub