指定セル範囲をDictionaryのItemを合計したい
配列の場合、気にせずセル範囲を格納できますが、
Dictionaryの場合は重複チェックをしないといけない為、少し手順を考えないといけません。
Dictionaryの場合は重複チェックをしないといけない為、少し手順を考えないといけません。
指定セル範囲を配列としてDictionaryに格納するサンプルコード
'参照設定 Microsoft Scripting Runtime Public Function RangeToDictionary(rng As Range) As dictionary Dim dic As dictionary Set dic = New dictionary Dim rCell As Range, tmp As String Dim sCol As Long, eCol As Long Dim i As Long, k As Long For i = rng.Row To rng.Row + rng.Rows.Count - 1 If Cells(i, rng.Column) <> "" Then '■Keyは指定範囲のセルの一番左側の行、Itemは指定範囲の2列目から最終列を配列としてitemに格納 If dic.Exists(Cells(i, rng.Column).Value) = False Then sCol = 1 eCol = rng.Column + rng.Columns.Count - 1 '■セル範囲をtmpに格納して、splitで分割して配列としてitemにする For k = sCol To eCol - 1 tmp = tmp & "," & Cells(i, rng.Column).Offset(0, k).Value Next k dic.Add Cells(i, rng.Column).Value, Split(tmp, ",") tmp = "" 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:A3").Value = "a" Range("A4:A4").Value = "b" Range("A5:A5").Value = "c" Range("B1:B5").Value = "りんご" Range("C1:C5").Value = 1000 Set arr = RangeToDictionary(Range("A1:C5")) 'A1~C5のセル範囲をItemに格納 Debug.Print arr.Item("a")(1) 'りんご Debug.Print arr.Item("a")(2) '1000 End Sub
コメント