連想配列（Dictionary）で一つのキーに対して複数のアイテムを格納する方法を検討
事務仕事を行っているとVBAのほかExcelの関数も使用する機会が多いです。
中でもVlookup関数やSUMIFS関数の頻度が高いのですが、これらの関数は対象の行数が多いと結果の表示に時間がかかることがあります。
（Office2016からVlookup関数は高速化されましたが、VBAの中で組み込むと計算が終了する前に次の処理に移ってしまったり、速度が遅かったりします。）
以前から連想配列（Dictionary）を用いてこれらの関数と同様の処理を高速にする方法をご紹介していますが、Dictionary型はキーとアイテムが一対一の関係にあるので、複数のアイテムを参照したい場合、都度Dicrionaryを宣言するのが手間になります。
今回はこの問題を解消した、複数カラム（アイテム）を参照する方法をご紹介します。
連想配列（Dictionary）で一つのキーに対して複数のアイテムを格納するには配列を使う
手順の考え方を先にお伝えすると、配列を使用することで一つのキーに対して複数のアイテムを持つことができるようになります。
配列の使い方は以下2通りが想定されました。
①一つのDictionary型のオブジェクトを宣言して、一つのキーに対してアイテムにセル範囲を格納した配列を割り当てる
②Dictionary型のオブジェクトを配列として宣言して、一つのキーに対して一つのアイテムを格納する。
少しイメージがつきにくいと思いますので、サンプルシートを用いて具体的な手順を記載します。
スポンサーリンク
連想配列を用いて集計をするためのサンプルシート
ある会社における店舗ごとの3か月ごとの売り上げ実績表のイメージになります。
A列に店固有のコード・B列は店舗名称になります。
C列には商品コードが入っていて、D列から後は3か月分の数量と原価・売価が書いてある表です。
サンプルで用意したこちらのシートは店舗数が77店舗、行数は約40,000行となっています。
Excelで加工するワークシートとしては容量が大きめかと思います。
こちらの数量・原価・売価について連想配列を用いて店舗ごとに集計するというのが今回ご紹介するコードの目的になります。
また、同じ処理はSUMIFS関数やピポットテーブルを使えば行うことができます。
ただし、SUMIFS関数は処理が遅い、ピポットテーブルはVBAで実行すると独特の挙動になるため、準備と後処理が面倒くさいのがネックになります。
その点連想配列を用いればスマートかつ高速に処理が可能です。
①一つのキーに対してアイテムにセル範囲を格納した配列を割り当てる
’エラー起こるので非推奨
Sheets(1).Select
Dim JANシート
Set JANシート = Sheets(1)
Dim JANシート下端行
JANシート下端行 = JANシート.Cells(Rows.Count, 1).End(xlUp).Row
Dim JANシート範囲
JANシート範囲 = Range(JANシート.Cells(1, 1), JANシート.Cells(JANシート下端行, 15))
Dim i, x, k
Dim dict実績 As Object
Set dict実績 = CreateObject(“Scripting.Dictionary”)
Dim itemRange
Dim storeCode()
x = 0
For i = 3 To JANシート下端行
If dict実績.Exists(JANシート範囲(i, 1)) = False Then
dict実績.Add (JANシート範囲(i, 1)), Range(Cells(i, 1), Cells(i, 15))
ReDim Preserve storeCode(x)
storeCode(x) = JANシート範囲(i, 1)
x = x + 1
Else
For k = 4 To 15
dict実績(JANシート範囲(i, 1))(k) = dict実績(JANシート範囲(i, 1))(k) + JANシート範囲(i, k)
Next k
End If
Next i
Sheets.Add before:=Sheets(1)
Dim r
r = Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(UBound(storeCode) + 2, 15))
For i = 1 To UBound(storeCode) + 1
r(i + 1, 1) = storeCode(i － 1) ’行番号は2からスタート、配列は0からスタート
For k = 4 To 15
r(i + 1, k) = dict実績(r(i + 1, 1))(k)
Next k
Next i
Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(UBound(storeCode) + 1, 15)) = r
Set dict実績 = Nothing
Set JANシート = Nothing
End Sub
dict実績という連動配列を宣言し、店舗コードをキーに、その行に含まれている実績を配列に格納します。
重複されるデータは繰り返し処理を用いてアイテムの配列に値を追加していく流れになります。
こちらで処理を実行すると、なぜかよくわからないのですが、セルの値が更新される不具合（？）が生じました。
実績自体は別シートに出力するので、もともとのシートは別に保存しておけば大丈夫かとも思いますが少し不気味な結果です。
セルを配列に格納する場合はセルの値を格納するというよりは、セルオブジェクトを配列に格納していると思われます。
そのため、加算をしたものがダイレクトにセルの値に反映されたと推測されるのですが、通常セルを配列に格納してもこの事象は起こらない気がしますので、正しいかどうかは不明です。
どのような原因にせよ連想配列のアイテムにセルを格納した配列を用いるのはあまり良くなさそうです。
一応、セルの値を配列に格納して更新する方法も試したのですが、こちらはセルの値が加算されず、最初に格納されたアイテムだけが吐き出される結果になりました。
こちらも不具合かもしれませんが、私には判断がつきませんでした。連想配列の挙動は少し不思議な感じがします。
それにそもそも最初にArray関数を使うところの記述が面倒で、要素数が増えるとかなり辛いのでそもそも却下です。
’エラー起こるし、きちんと動かない
Sheets(1).Select
Dim JANシート
Set JANシート = Sheets(1)
Dim JANシート下端行
JANシート下端行 = JANシート.Cells(Rows.Count, 1).End(xlUp).Row
Dim JANシート範囲
JANシート範囲 = Range(JANシート.Cells(1, 1), JANシート.Cells(JANシート下端行, 15))
Dim i, x, k
Dim dict実績 As Object
Set dict実績 = CreateObject(“Scripting.Dictionary”)
Dim itemRange
Dim storeCode()
x = 0
For i = 3 To JANシート下端行
If dict実績.Exists(JANシート範囲(i, 1)) = False Then
dict実績.Add (JANシート範囲(i, 1)), Array(Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value, Cells(i, 4).Value, Cells(i, 5).Value, Cells(i, 6).Value, Cells(i, 7).Value, Cells(i, 8).Value, Cells(i, 9).Value, Cells(i, 10).Value, Cells(i, 11).Value, Cells(i, 12).Value, Cells(i, 13).Value, Cells(i, 14).Value, Cells(i, 15))
ReDim Preserve storeCode(x)
storeCode(x) = JANシート範囲(i, 1)
x = x + 1
Else
For k = 4 To 15
dict実績(JANシート範囲(i, 1))(k － 1) = dict実績(JANシート範囲(i, 1))(k － 1) + Cells(i, k).Value
Next k
End If
Next i
Sheets.Add before:=Sheets(1)
Dim r
r = Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(UBound(storeCode) + 2, 15))
For i = 0 To UBound(storeCode)
r(i + 2, 1) = storeCode(i) ’行番号は2からスタート、配列は0からスタート
For k = 4 To 15
r(i + 2, k) = dict実績(r(i + 2, 1))(k － 1)
Next k
Next i
Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(UBound(storeCode) + 2, 15)) = r
Set dict実績 = Nothing
Set JANシート = Nothing
End Sub
②Dictionary型のオブジェクトを配列として宣言する
上記の2つの配列を使う方法がうまくいかなかったので、他に方法を検討して思いついたのがこちらの方法です。
若干手順が面倒ですが、繰り返し処理を付け加えるだけで上記①と似た手間になるので私としては現在この方法が最も現実的かと思います。
’宣言のところで繰り返しが必要だが基本使いやすい
Sheets(1).Select
Dim JANシート
Set JANシート = Sheets(1)
Dim JANシート下端行
JANシート下端行 = JANシート.Cells(Rows.Count, 1).End(xlUp).Row
Dim JANシート範囲
JANシート範囲 = Range(JANシート.Cells(1, 1), JANシート.Cells(JANシート下端行, 15))
Dim i, x, k
Dim dict実績(1 To 15) As Object
For k = 1 To 15
Set dict実績(k) = CreateObject(“Scripting.Dictionary”)
Next k
Dim itemRange
Dim storeCode()
x = 0
’Itemにセルを格納した配列はあまり良くない?
’array使ってvalueを格納すると加算ができない
’variant型の変数にセルを直接配列として格納するとセルの値が変更される
For i = 3 To JANシート下端行
If dict実績(1).Exists(JANシート範囲(i, 1)) = False Then
For k = 1 To 15
dict実績(k).Add (JANシート範囲(i, 1)), JANシート範囲(i, k)
Next k
ReDim Preserve storeCode(x)
storeCode(x) = JANシート範囲(i, 1)
x = x + 1
Else
For k = 4 To 15
dict実績(k)(JANシート範囲(i, 1)) = dict実績(k)(JANシート範囲(i, 1)) + JANシート範囲(i, k)
Next k
End If
Next i
Sheets.Add before:=Sheets(1)
Dim r
r = Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(UBound(storeCode) + 2, 15))
For i = 0 To UBound(storeCode)
r(i + 2, 1) = storeCode(i) ’行番号は2からスタート、配列は0からスタート
For k = 4 To 15
r(i + 2, k) = dict実績(k)(r(i + 2, 1))
Next k
Next i
Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(UBound(storeCode) + 2, 15)) = r
For k = 1 To 15
Set dict実績(k) = Nothing
Next k
Set JANシート = Nothing
End Sub
先ほどとは違いDictionary型を配列として宣言し、15個分の連想配列を繰り返し処理で準備します。
吐き出すときはdict実績(インデックス番号)(“キー”)で出力できるようにして、かつ列番号とインデックス番号を揃えておくことで見やすくもなります。
こちらの処理は問題なく動きました。
コメント