指定セル範囲をDictionaryのItemを合計したい
配列の場合、気にせずセル範囲を格納できますが、
Dictionaryの場合は重複チェックをしないといけない為、少し手順を考えないといけません。
Dictionaryの場合は重複チェックをしないといけない為、少し手順を考えないといけません。
指定セル範囲をDictionaryに格納するサンプルコード
'参照設定 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
コメント