Excel VBA - 連想配列（Dictionary オブジェクト）を使った大量データ高速抽出・集計処理メモ
Excel VBA で大量データを高速抽出・集計処理するために連想配列（Dictionary オブジェクト）を使った VBA コードを公開します。
Excel と Excel Visual Basic Editor（VBE）の環境設定については 以前公開した記事 よりご確認ください。
VBA および連想配列（Dictionary オブジェクト）を使うことになったきっかけ
Excel でのデータ抽出処理で、シート内で VLOOKUP や INDEX・MATCH 関数を使ったデータ抽出をしていましたが、対象のデータ件数が多くなるとちょっとした変更だけでも関数の処理によって非常に遅くなり、頭を悩ませていました。
データ内容にもよりますが、おおむねデータ件数が数万～数十万件になると処理に時間がかかるようになり、加えて項目数が数十項目以上となると、これもさらに処理が重くなる原因になっているのではないかという感じです。
この問題を改善するためにいろいろ調べたところ、こちら と こちら の動画より VBA で連想配列（Dictionary オブジェクト）を使うと処理時間を劇的に改善できるということがわかりました。さらに探してみるとほかの解説サイトや動画でも同様の内容や様々なテクニックがたくさん公開されていたので、今までほとんど触ってこなかった VBA を本格的に勉強して使うきっかけとなりました。
これまでは VLOOKUP や INDEX・MATCH 関数などシート内の各セルに関数を設定すれば十分だろうと思っていましたが、VBA での処理がほぼ一瞬で終わってしまうようなことを経験してからは、Excel で大量のデータを処理するには VBA（特に配列や連想配列）を使うことが、今更ながら外せなくなりました。
VBA でのコード記述ではデバッグだけでなく、エラーや思った通りに動かない・結果にならないという難敵だらけの戦いに避けて通れません。それでも、VBA で処理を完結させることでシート内での各セルでの関数が不要になるので、各シートには純粋な（処理前・処理後の）データだけで管理できるというのは大きなメリットです。
ただ、VBA は決して万能ではなく、（これはプログラミング全般に言えることだと思いますが）コードの書き方によっては処理時間が改善されなかったり、かえって処理が遅くなってしまうことがあります。そういったところはネックとなるコードを特定して、改善や工夫、時には根本的な見直しが必要になるときがあります。
この作業を怠ると何十分・何時間も処理が走り続けることになってしまい、1回きりの処理なら許容範囲かもしれませんが何回も実行するようであれば、そのたびに時間を無駄にしてしまいます。エラーなく求める結果になるように動作することは大前提で重要なことですが、そのあとどれだけ最適化できるかどうか、VBA に関する知識と情報・その応用から発想の転換などその人の腕が問われることになります。（参考動画）
VBA に依存せず、ほかの言語・オンラインサービスでも同様な処理を短時間でできるようにすることは、様々な手段を確保しておくことや今後の効率化の観点からみてもとても重要だと思います。ですが、自身の書いた処理速度が恐ろしく遅い非効率なコードを（悪意はないと思いたいですが）まるで VBA のせいかのような発言をして、処理が速いという理由だけでほかの言語に移行してしまうというのは、実力不足を自らアピール・露呈しているように見えてしまいます。
この辺は見極めが難しく、便利ツールの延長線上の扱い程度や問題解決に長い時間をかけていられない状況であれば、従来のやり方に固執せずにほかに良いものがあれば、さっさと乗り換えてしまうのはある意味正解ということもあるでしょう。ただ、原因を特定しないまま計測結果だけで言語の良し悪しを判断してしまうのは、理由としては安直すぎます。
VBA では解決が難しい問題があるかもしれませんが、VBA の処理時間で何十分・何時間もかかっているようなことを公言して、原因の特定や見直しをしない、またはその内容を公開・共有しようとせず、処理時間の結果だけを強調して語り、それだけの理由でほかの言語に乗り換えたとかいう人の話を鵜呑みにしないように注意したいところです。
「VBA 高速化 "テクニック"」と言っていますが、本来であれば "テクニック" 以前の問題が多いです。～（中略）～。マクロ全体の構成や "考え方" も検討してください。プラン A では遅かった。じゃ、プラン B でやってみよう。それでも遅かったらプラン C で。というように、どれだけ多くの "選択肢" を持っているかが高速化には重要です。よろしいですか？VBA が遅いのではありません。あなたのコードが遅い んです。
VBA 高速化テクニック より一部抜粋
Excel の欠点の一つと感じているのが、1つのブックに複数のワークシートで大量のデータが存在すると、Excel でファイルを開く・セル移動・保存が遅くなってしまうことです。特に Excel の起動が遅くなるところは顕著です。この辺はやはり大量のデータを管理・処理するのに向いたデータベース系ソフトに分があるといった感じでしょうか。VBA の前に Excel で大量のデータを管理することについては、よく検討した方がいいかもしれません。
幸いネット上には Excel および VBA に関する情報が豊富にあります。ちょっとした使い方・テクニック・トラブルシューティングから VBA による高度な処理方法・解説・サンプルコードが公開されているので、ゼロから自力で解決するようなことがほぼないというくらいには充実しています。そのおかげで、今回公開できた VBA コードのほとんどはネットにある情報だけで完成することができました。反面、それだけ情報も氾濫しているので目的やヒントとなる情報を見つけるのに苦労したところもあります。
この記事では連想配列（Dictionary オブジェクト）について取り上げていますが、必ずしも最速で処理できるというわけではありません。データ件数が非常に多ければ Collection オブジェクトのほうが処理時間的に優秀という情報があったり、ワークシート関数（WorksheetFunction）で同じ処理ができればコードが短くなる上に処理時間も速くなる場合もあります。
ここでは私が作成した VBA コードをいくつか紹介しますが、ほかの用途でも流用できるように柔軟性とメンテナンス性を保ちつつ、なるべく初めから終わりまでのコード内容を共通化させています。処理速度については処理方法・データ量にもよりますが、一部のコード以外についてはこちらで確認できた範囲内で、10万件・20列程度のデータを現実的な時間内で完了できるように想定しています。
連想配列（Dictionary オブジェクト）以外の方法や VBA での処理速度に関する内容については、以下の参考サイトよりご確認ください。
連想配列（Dictionary オブジェクト）データ抽出用サンプルファイル（xlsx ファイル）
連想配列（Dictionary オブジェクト）データ抽出用のサンプルファイル（xlsx ファイル）を公開します。データ集計用のサンプルファイルと VBA コードは こちらのセクション で説明します。
サンプルデータは Start Point さんのところで公開しているコピペで使える都道府県一覧リスト・県庁所在地一覧 を利用しています。
こちらで作成した 都道府県県庁所在地地方区分抽出A.xlsx ファイル と 都道府県県庁所在地地方区分抽出B.xlsx ファイル を用意しました。ファイル名リンクをクリックすると Google ドライブからダウンロードするようにしています。
データ件数は 47件（47 都道府県）しかないので、VBA コード別の処理速度の違いについては参考になりません。ちょうどよい大量のサンプルデータを用意できなかったので、こちらで数万件の別データを使ったときに処理速度の差を確認できた時について、記事内で補足で説明する程度です。
都道府県県庁所在地地方区分抽出A.xlsx ファイル は VBA コードを実行する前の状態、都道府県県庁所在地地方区分抽出B.xlsx ファイル は VBA コード実行後の処理結果内容となっています。
いずれも xlsx ファイルとなっており VBA コードは含まれていません。VBA コードを実行するにはファイル拡張子が xlsm（マクロ有効ブック）となっている必要がありますが、xlsm 形式での配布は念のため避けています。
VBA コードを実行するには 都道府県県庁所在地地方区分抽出A.xlsx ファイル をダウンロード後 xlsm 形式に保存、Visual Basic Editor（VBE）を起動して参照設定から「Microsoft Scripting Runtime」を設定（事前バインディング） します。以降各セクションで紹介している VBA コードを各自追加して実行してもらう形としています。
VBA コードの追加方法は VBE のプロジェクトエクスプローラー（Ctrl + R キー）画面にて、開いている VBAProject（ファイル名.xlsm）→「標準モジュール」を開き、右クリックから「挿入」→「標準モジュール」でクリック、追加した標準モジュールに記事内にある VBA コードを貼り付けることで動作できるようにしています。
一部 VBA コード内にある Call ステートメントを使った Function プロシージャの呼び出し については、呼び出し先標準モジュールのプロパティ（F4 キー）画面から（オブジェクト名）欄を設定するのが前提となっています。
データ抽出処理について、全部で 3種類の連想配列（Dictionary オブジェクト）を使った VBA コードを公開します。いずれも処理結果は同じになりますが、条件によってはエラーが発生するもの、大量のデータ高速抽出処理には不向きなもの、これらの問題点を改善したもの、全部で 3 4つの VBA コードを紹介します。
今回公開する VBA コードで処理速度以外での特長としては、Dictionary に必要なキーと対になるアイテムを自由に複数登録・取得できる ようになっている点です。この辺の情報が少なくて Dictionary を使う点では個人的に苦労しました。
VBA コードの詳細な内容については各セクションで説明します。
連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1（条件によってエラーあり、大量データ抽出処理×）
以下、連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1 です。この VBA コードが基本的な形となるためこのセクションでは各コード内容をすべて解説します。
この VBA コードはシート「都道府県県庁所在地地方区分抽出1」の都道府県コード（1 ～ 47）を検索キーとして、シート「都道府県県庁所在地地方区分ランダム並べ替え」にある、ランダムに並べ替えられた各都道府県データから検索キーと一致するデータ（都道府県、Prefectures、県庁所在地、Capital、地方区分）を抽出します。
抽出した都道府県データをシート「都道府県県庁所在地地方区分抽出1」の各都道府県コードに対応するセルに反映（転記）するコード内容となっています。抽出したデータの反映先がわかりやすいように、あらかじめ該当セルを罫線で囲んでいます。
VLOOKUP や INDEX・MATCH 関数で可能なことを VBA の連想配列（Dictionary オブジェクト）を使って対応させたものとなります。
データ件数が少なければ VLOOKUP や INDEX・MATCH 関数が手軽で十分なのですが、データ件数が多くなるとそれにあわせてシート内各セルに関数を代入することになり、処理時間が長くなってしまう欠点があります。
そこで出番となるのか VBA で連想配列（Dictionary オブジェクト）を使う方法です。ほかにも方法はありますが、いろいろ触ってきた中では連想配列（Dictionary オブジェクト）が汎用性が高く、検証していませんが処理速度は最速とまではいかないかもしれませんが、十分許容できる範囲内だと思います。
なお、このあと紹介する VBA サンプルコード 2 については VBA サンプルコード 1 の 問題点 の一部を、VBA サンプルコード 3 と VBA サンプルコード 4 は 問題点 全部を書き換えて処理内容を改善したものとなっています。
Option Explicit ステートメント
Option Explicit
VBE のオプション設定画面で、編集タブ - コードの設定 - 「変数の宣言を強制する」にチェックマークを入れてオンにすることで、モジュールの先頭に Option Explicit が自動的に記述されます。
これにより変数のスペルミスや型違いによるエラー発生を防止できます。
なお、配列のインデックス番号（添え字）の最小値を 0 または 1 に指定できる Option Base ステートメントについては使用しません。
VBA 実行速度測定
' 実行速度計測開始
Dim starttime As Double
starttime = Timer
' 実行速度計測結果表示
Debug.Print Format(Timer - starttime, "0.00秒")
End Sub
こちらの動画 を参考に Sub プロシージャ内の最初と最後に Timer 関数を設置して処理速度を計測しています。
変数宣言位置
' カウンタ用変数（一見見分けにくい文字同士を組み合わせない形、i と j、m と n、o（オー） と 0（ゼロ））
Dim i As Long, k As Long
以下のサイト内容を参考に必要な変数はなるべく直前に宣言するようにしています。
ただ、すべての変数を処理の直前に宣言してしまうとバラバラでまとまりがなく、かえって見づらくなる可能性が考えられます。そのため、ある程度まとめて変数を宣言する形にして、変数宣言部分と処理部分の固まりに分けて区別できるようにしています。
例外として各処理内で汎用的に使われるカウンタ変数については、あらかじめ Sub プロシージャの先頭部分に必要な分をまとめて宣言しています。
慣例的にプログラムで使われていると思われるカウンタ変数名を一部宣言していますが、一見似ている判別しにくい文字（i と j、o（オー）は 0（ゼロ）と似ているので o（オー）は避けるなど）との組み合わせはなるべく避けるようにしています。
なお、特に深い理由はありませんが、各変数宣言セクションでは変数の Variant 型については省略せず、全部明示的に宣言しています。私が単に慣れていないだけかもしれませんが変数の型をいれておくことで、この部分には変数を宣言しているというのがパッと見わかるようにしているのが一応の理由です。
変数名やプロシージャ名などの命名規則についてはなるべく用途に対して一貫性があるようにしていますが、新たに変数を追加したときに破綻（変数に格納するデータが変数名に対して、エラーは起きないが矛盾しているなど）したときの修正が大変なので、いくつかの個所では適当な名前（末尾に数字付加など）をつけていることがあります。
オブジェクト変数と Set ステートメント
' シート格納用オブジェクト変数
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
' オブジェクト変数にシートセット
Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え") ' 検索先シート（Key, Item）をオブジェクト変数にセット
Set ws2 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分抽出1") ' 検索元シート（Key）をオブジェクト変数にセット
' Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート
オブジェクト変数と Set ステートメントを使って対象のワークシート名をまとめて設定します。
以降、ワークシート名の指定は WorkSheet オブジェクトを格納したオブジェクト変数で指定します。
ワークシート最終行・最終列取得
' 最終行取得用変数
Dim maxrow1 As Long, maxrow2 As Long
' 各シートの最終行取得して変数に格納
maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
' 最終列取得用変数
Dim maxcol1 As Long
' シートの最終列取得して変数に格納
maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
ワークシートの最終行・最終列を取得して変数に格納します。取得方法は定番の VBA コードとして決まっているのでそのまま流用しています。
以降、ワークシートの最終行・最終列の指定には、取得時に格納した変数を使いまわします。
処理対象のデータ内容にもよりますが、列数が目視で数えられる程度なら最終列の取得と変数への格納は行わず、直接列番号を指定して済ませることがあります。
各シートのセル範囲を指定してセル値をまとめて 2次元配列に格納
' 各シートの指定したセル範囲（Key, Item, 一致したデータ出力先）を配列として格納する動的配列
Dim data1() As Variant, data2() As Variant, data3() As Variant
' 各シートの指定した範囲内セル（Key, Item, 一致したデータ出力先）を配列として動的配列に格納
data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value ' 検索先シート（Key, Item）最終行・最終列までを Range で範囲指定、配列として動的配列にセット
data2 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索元シート（Key）最終行までを Range で範囲指定、配列として動的配列にセット
data3 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)).Value ' 検索元シートの Item データ出力先起点セルから最終行までを Range で範囲指定、配列として動的配列にセット（検索元シート（Key）と一致した検索先シート Item データを格納）
' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
' data1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))
' data2 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)))
' data3 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)))
配列による処理高速化のため、各シートの指定したセル範囲を 2次元配列に格納します。（参考動画）
55 ～ 57行目にある自作関数 GetArrFromRange については 次のセクション で解説します。
VBA における配列の基本的な内容については以下の参考サイトよりご確認ください。
47行目に配列として格納するための変数をバリアント型（Variant）の動的配列として宣言します。
各変数名の後ろに () を入れているため動的配列となっていますが、() がないバリアント型変数でも 条件次第 ですが問題なく同じ結果を得られます。ここでは こちらのサイト を参考に動的配列で統一しています。
ここでは 3つのバリアント型動的配列を変数として宣言して使います。（47行目）
これは連想配列（Dictionary オブジェクト）を使うためにそれぞれ、検索先シート（辞書登録対象データを動的配列 data1 へ）と検索元シート（検索キーを動的配列 data2 へ）のデータ格納、検索キーを使って辞書から一致したアイテムの一時的データ格納先（動的配列 data3）として扱うために分けています。
動的配列 data1 に オブジェクト変数 ws1 を使って、キーとアイテムがあるシート全体を格納しています。動的配列 data2 と data3 はオブジェクト変数 ws2 を使って同じワークシートを指定していますが、動的配列 data2 は検索キーのみを、動的配列 data3 はアイテム転記先のセル範囲というように分けています。
配列に格納したいセル範囲の取得には Range プロパティで範囲指定します。Range プロパティの基本的な使い方については以下の参考サイトよりご確認ください。
各 Range プロパティと Cells プロパティを使ってシート別セル範囲を指定するには、WorkSheet オブジェクトを格納したオブジェクト変数 を使用します。（参考動画）
オブジェクト変数ではなく WorkSheet オブジェクトで直接指定することも可能ですが、コードが長くなるうえに流用したときに対象のワークシート名の書き換えが面倒になるので、オブジェクト変数を使うようにしています。（参考情報）
1行 1列のセル値 → 2次元配列格納自作関数（オプション）
範囲指定でセルの値を取得して 2次元配列に格納 する場合、条件によってはエラーが発生します。
セル範囲を指定した際に 1行 1列 だった場合、動的配列へ代入時「型が一致しません。」とエラーメッセージが表示されて処理が止まります。行または列どちらか複数あれば 2次元配列として格納できます。（セル範囲が 2行 1列でも 1行 2列でも配列として格納可）
なお、変数名の後ろに () を付加した動的配列ではなく、() がないバリアント型変数であればエラーは発生しません。ただ、1行 1列（1セル）の場合、そのセルに格納されていた数値または文字列にあわせた型で格納されるので、2次元配列としては格納されません。
この問題は ネットで公開されている自作関数 GetArrFromRange を使うことで、たとえ 1行 1列の 1セルであっても 2次元配列を返して格納することができます。
Public Function GetArrFromRange(rng As Range) As Variant
' Range オブジェクトを受け取り､二次元配列で返す
' 参考記事 【VBA】セルの値を取得して二次元配列へと入れる方法(セルが 1つの場合にも対応) https://yaromai.jp/cellvalue-array/
Dim oneArr(1 To 1, 1 To 1)
If rng.Count = 1 Then
oneArr(1, 1) = rng.Value
GetArrFromRange = oneArr
Else: GetArrFromRange = rng.Value
End If
End Function
上記 VBA コードは Range オブジェクトを受け取り、2次元配列を返す自作関数 GetArrFromRange です。コード内容はそのままですが、部品化のため別の標準モジュールに登録し、Public Function に変更しています。
関数を呼び出せるようにするため、自作関数を登録した標準モジュールのプロパティ（F4 キー）画面から（オブジェクト名）欄を設定（名前は任意）します。ここでは自作関数名と同じ GetArrFromRange に設定して話を進めます。
自作関数呼び出しの際に関数名とプロパティのオブジェクト名を使用します。（参考情報）
' 各シートの指定したセル範囲（Key, Item, 一致したデータ出力先）を配列として格納する動的配列
Dim data1() As Variant, data2() As Variant, data3() As Variant
' 各シートの指定した範囲内セル（Key, Item, 一致したデータ出力先）を配列として動的配列に格納
' data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value ' 検索先シート（Key, Item）最終行・最終列までを Range で範囲指定、配列として動的配列にセット
' data2 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索元シート（Key）最終行までを Range で範囲指定、配列として動的配列にセット
' data3 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)).Value ' 検索元シートの Item データ出力先起点セルから最終行までを Range で範囲指定、配列として動的配列にセット（検索元シート（Key）と一致した検索先シート Item データを格納）
' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
data1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))
data2 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)))
data3 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)))
50 ～ 52行目をコメントアウトして、55 ～ 57 行目のコメントアウトを外して自作関数 GetArrFromRange を呼び出します。
標準モジュールのオブジェクト名の後にドットを入力（GetArrFromRange.）すると、インテリセンスで標準モジュールに登録した自作関数名が表示（GetArrFromRange.GetArrFromRange）されます。ここではオブジェクト名と自作関数名は同じにしています。
自作関数名のカッコ内 GetArrFromRange.GetArrFromRange(ここ) に 50 ～ 52 行目の Range オブジェクトをそのまま代入します。Value プロパティは不要です。Value プロパティがあるとエラーが発生します。
一時データ格納先 2次元配列各要素初期化
' Item データ格納用 2次元配列の最大要素まで Empty で初期化（繰り返し（やり直し）処理に対応）
' For 文を使った 2次元配列の最大要素までの初期化
For i = LBound(data3, 1) To UBound(data3, 1) ' 1次元最大要素までループ処理
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素までループ処理
data3(i, k) = Empty ' 配列に Empty を代入して初期化
Next k
' data3(i, 1) = Empty ' for 文を使わない場合の書き方
' data3(i, 2) = Empty ' for 文を使わない場合の書き方
' data3(i, 3) = Empty ' for 文を使わない場合の書き方
' data3(i, 4) = Empty ' for 文を使わない場合の書き方
' data3(i, 5) = Empty ' for 文を使わない場合の書き方
Next i
' Redim ステートメントを使った 2次元配列の最大要素までの初期化
' ReDim data3(1 To UBound(data3, 1), 1 To UBound(data3, 2))
連想配列（Dictionary オブジェクト）で検索キーを使って辞書から一致したデータの一時格納先の 2次元配列 を繰り返し処理に対応できるように各要素を初期化します。
ただ、今回のデータ内容・処理方法では毎回必ず上書きされるので初期化する必要はありません。
なぜこの処理をわざわざ入れているかについては、なんらかの原因で意図せず前回の処理結果が残ってしまった時のデータを残さないようにするためです。これはデータ一時格納先 2次元配列のセル範囲の指定がデータ転記先となっているため、初回処理時はセルにデータがない状態なので気にすることはありませんが、2回目以降はすでにデータがある状態なので、データ一時格納先 2次元配列を取得する際にデータも一緒に格納されてしまうためです。
そのため、繰り返して処理する際に前回のデータが残っているセルを一時データ格納先として 2次元配列を作成する場合は、念のため作成した 2次元配列の各要素を事前に初期化するようにします。
上記 VBA コード 64 ～ 73 行目は典型的な For 文を使ったループ処理です。2次元配列の各要素に Empty を代入して初期化する方法です。
For 文とカウンタ変数、LBound 関数と UBound 関数を組み合わせて、対象の 2次元配列 data1 の 1次元（行相当）と 2次元（列相当）の最小～最大要素までループさせます。配列のループ処理には LBound 関数と UBound 関数をよく使います。これで 2次元配列の各要素に Empty を代入して初期化扱いにしています。
ちなみに 76 行目は Redim ステートメントを使った 2次元配列の初期化方法です。64 ～ 73 行目を実行したときと同じ処理結果になります。UBound 関数を使って初期化対象の 2次元配列 data3 の 1次元・2次元の最大要素番号を指定しています。最小値を取得する LBound 関数は使っていません。
1次元・2次元ともに開始要素番号を 1 から（1 To ～）にしてるのは、動的配列（バリアント型変数）にセル範囲を代入して 2次元配列を作成した場合、最小要素番号が 1 からになるため、それに合わせている形となっています。（参考動画 1、参考動画 2）
なお、ReDim data3(UBound(data3, 1), UBound(data3, 2)) とした場合、開始要素番号は 0 からとなります。
連想配列（Dictionary オブジェクト）にキー・アイテム登録
' 変数宣言
Dim myDic As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Set myDic = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Dim key1 As String ' Dictionary 用 Key 変数
Dim vals1() As Variant ' Dictionary 用 Item 変数（動的配列）
' 検索先シートの Key と Item を Dictionary に登録
For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した検索先シートの 1次元最大要素までループ処理
' 検索先シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
key1 = data1(i, 1)
' Array 関数の要素に検索先シート i 行目の 2列目（都道府県）、3列目（Prefectures）、4列目（県庁所在地）、5列目（Capital）、6列目（地方区分）をセットし、
' Dictionary 用 Item 変数（動的配列）に代入
vals1 = Array(data1(i, 2), data1(i, 3), data1(i, 4), data1(i, 5), data1(i, 6))
' Key 重複登録判定
If Not myDic.Exists(key1) Then
myDic.Add key1, vals1 ' 重複していなければ Key, Item 辞書登録
End If
Next i
必要なデータの事前準備ができたので、連想配列（Dictionary オブジェクト）を使ってキーとアイテムを辞書登録します。
81 ～ 82行目は連想配列（Dictionary オブジェクト）を使うのに必要な事前バインディングのコードです。
このコードの書き方の場合 Visual Basic Editor（VBE）の参照設定で Microsoft Scripting Runtime を設定 しておく必要があります。
コードは 2行ですが 1行に短縮して記述する方法もあります。以下の参考サイトの情報より、ここではオブジェクト変数の宣言と Set ステートメントの 2行に分けておくことにしています。
83 ～ 84 行目に連想配列（Dictionary オブジェクト）用のキー変数とアイテム変数を宣言します。キー変数は String 型、アイテム変数は Variant 型の動的配列としています。
87行目の For 文と LBound・UBound 関数で、辞書登録対象の 2次元配列 data1 の 1次元最大要素（行相当）までループ処理します。
89行目でキー変数に 2次元配列 data1 にあるキーを代入します。
92行目で動的配列のアイテム変数に、2次元配列 data1 にある登録対象の複数のアイテムを Array 関数を使って代入します。Array 関数を使うことで複数のアイテムを動的配列に自由にまとめて登録できます。（参考情報、参考動画）
ちなみに Array 関数以外を使った書き方もあります。内容は こちら で説明しています。
95行目の If Not 文と Dictionary オブジェクトの Exists メソッドを組み合わせて、キーの重複判定をします。
キーの重複がなければ 96行目で Dictionary オブジェクトの Add メソッドでキーとアイテムを登録します。
ちなみに最初は何も登録されていない状態のため、処理開始時の最初のキー・アイテムは必ず登録処理を行うことになります。
連想配列（Dictionary オブジェクト）から検索キーを使ってアイテム取得
' 変数宣言
Dim key2 As String ' Dictionary 用 Key 変数
Dim vals2() As Variant ' Dictionary 用 Item 変数（動的配列）
' 検索元シートの Key で検索先シートの Item を取得
For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
key2 = data2(i, 1) ' 検索元シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
vals2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード））と一致した Item を動的配列に格納
' 動的配列に格納した Item 有無判定
If Not IsEmpty(vals2) Then ' Item が Empty ではない場合
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
' 1次元配列から 2次元配列への代入が遅い？
data3(i, k) = vals2(k - 1) ' Item データを配列に格納
Next k
' data3(i, 1) = vals2(0) ' for 文を使わない場合の書き方 - 中身は Item の 都道府県
' data3(i, 2) = vals2(1) ' for 文を使わない場合の書き方 - 中身は Item の Prefectures
' data3(i, 3) = vals2(2) ' for 文を使わない場合の書き方 - 中身は Item の 県庁所在地
' data3(i, 4) = vals2(3) ' for 文を使わない場合の書き方 - 中身は Item の Capital
' data3(i, 5) = vals2(4) ' for 文を使わない場合の書き方 - 中身は Item の 地方区分
Else ' Item が Empty の場合 → myDic(key2) が Empty の場合、vals2 = myDic(key2) でエラーが発生するためこの処理は通らない
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
Next k
' data3(i, 1) = "*****" ' for 文を使わない場合の書き方
' data3(i, 2) = "*****" ' for 文を使わない場合の書き方
' data3(i, 3) = "*****" ' for 文を使わない場合の書き方
' data3(i, 4) = "*****" ' for 文を使わない場合の書き方
' data3(i, 5) = "*****" ' for 文を使わない場合の書き方
End If
Next i
キー・アイテム登録した連想配列（Dictionary オブジェクト） から検索キーを使ってアイテムを取得します。
103 ～ 104行目に連想配列（Dictionary オブジェクト）用のキー変数とアイテム変数を宣言します。キー変数は String 型、アイテム変数は Variant 型の動的配列で、これは 83 ～ 84 行目で宣言した変数と同じ で違いは変数名となっています。前に宣言した変数をそのまま流用することができますが、デバッグ用にあえて新たに変数を宣言して使い分けています。
107行目の For 文と LBound・UBound 関数で、キー登録した 2次元配列 data2 の 1次元最大要素（行相当）までループ処理します。
108行目でキー変数に 2次元配列 data2 にある検索キーを代入します。
109行目で 辞書（myDic） からキー変数と一致したアイテムを動的配列に格納します。このコードはある条件で必ずエラーが発生します。この影響で 122行目の Else 文は絶対に通らないことになります。エラー条件や詳細については 後述。
112行目の If Not 文で配列 vals2 に格納したアイテムが Empty かどうか、IsEmpty 関数で判定します。
アイテムが Empty でなければ 113行目で For 文・カウンタ変数・LBound・UBound 関数で、データ格納先 2次元配列 data3 の 2次元（列相当）の最小～最大要素までループします。
115行目の For 文内でカウンタ変数 k を使って動的配列 vals2 の各要素番号を指定、同じくカウンタ変数 i と k を使ってデータ格納先 2次元配列 data3 に辞書から見つかった各々のアイテムデータを代入します。ちなみに こちら で軽く触れますが、この代入方法は文字列中心の大量データの処理には（おそらく）向きません。こちら で処理速度を改善した VBA サンプルコードを紹介します。
連想配列（Dictionary オブジェクト）から抽出したアイテムをシートへ転記
' 動的配列に格納した配列 data3 の Item 内容を、検索元シートの Range で指定したセルから Resize で範囲を変更してセルに代入
ws2.Range("B2").Resize(UBound(data3, 1), UBound(data3, 2)).Value = data3
ws2.Activate
' テスト用シートに出力する場合は以下のテスト用シートを格納したオブジェクト変数に変更
' ws3.Range("B2").Resize(UBound(data3, 1), UBound(data3, 2)).Value = data3
' ws3.Activate
辞書から検索キーを使って抽出したアイテムデータをシートに転記します。
137行目で データ格納先 2次元配列 data3 に代入されたアイテム を、指定したシートのセル範囲に一気に転記できます。
シートとセル範囲の指定には「オブジェクト変数 + Range プロパティ + Resize プロパティ」を使います。
Range オブジェクトでデータ転記先の開始セルを指定します。
Resize プロパティでは UBound 関数で 2次元配列の 1次元（行相当）と 2次元（列相当）の最大要素を指定することで、2次元配列のデータ内容すべてをセルに展開できます。
最後に Activate メソッドを使ってデータが転記されたかどうか確認できるようにするため、シートをアクティブにして移動しています。
ここまでが連想配列（Dictionary オブジェクト）を使った基本的なデータ抽出処理の流れです。
この VBA コードには問題点が 2つあります。次 にその問題点を説明します。
問題点（条件によってエラーあり、大量データ抽出処理×）
' 変数宣言
Dim key2 As String ' Dictionary 用 Key 変数
Dim vals2() As Variant ' Dictionary 用 Item 変数（動的配列）
' 検索元シートの Key で検索先シートの Item を取得
For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
key2 = data2(i, 1) ' 検索元シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
vals2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード））と一致した Item を動的配列に格納
' 動的配列に格納した Item 有無判定
If Not IsEmpty(vals2) Then ' Item が Empty ではない場合
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
' 1次元配列から 2次元配列への代入が遅い？
data3(i, k) = vals2(k - 1) ' Item データを配列に格納
Next k
' data3(i, 1) = vals2(0) ' for 文を使わない場合の書き方 - 中身は Item の 都道府県
' data3(i, 2) = vals2(1) ' for 文を使わない場合の書き方 - 中身は Item の Prefectures
' data3(i, 3) = vals2(2) ' for 文を使わない場合の書き方 - 中身は Item の 県庁所在地
' data3(i, 4) = vals2(3) ' for 文を使わない場合の書き方 - 中身は Item の Capital
' data3(i, 5) = vals2(4) ' for 文を使わない場合の書き方 - 中身は Item の 地方区分
Else ' Item が Empty の場合 → myDic(key2) が Empty の場合、vals2 = myDic(key2) でエラーが発生するためこの処理は通らない
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
Next k
' data3(i, 1) = "*****" ' for 文を使わない場合の書き方
' data3(i, 2) = "*****" ' for 文を使わない場合の書き方
' data3(i, 3) = "*****" ' for 文を使わない場合の書き方
' data3(i, 4) = "*****" ' for 文を使わない場合の書き方
' data3(i, 5) = "*****" ' for 文を使わない場合の書き方
End If
Next i
この VBA サンプルコード 1 には問題点が 2つあります。
1つ目は 109行目で 辞書（myDic） からキー変数と一致したアイテムを動的配列に格納していますが、辞書に登録されていないキーがある場合 Empty となります。この状態で動的配列に Empty を代入しようとすると「型が一致しません。」というメッセージが表示されてエラーで止まります。（参考情報）
例えば検索キーに都道府県コード 48 があった場合、辞書には存在しないコードとなっているので Empty を返す（参考情報 1、参考情報 2）ようです。Empty を動的配列に代入しようとするとエラーになるという流れです。
検索キーすべてが辞書登録されていればエラーは発生しません。また、辞書側にしかないキーが登録してあっても、参照の有無にかかわらず単に辞書に登録してあるだけなのでこれも問題ありません。問題となるのは辞書に登録されていない検索キーで、辞書へ参照する時です。
この仕様を逆手に取れば辞書から検索キー有無の確認ができることになるので、存在しない検索キーがあれば処理を止めることができるチェックシステムに使えることになります。
動的配列に Empty を代入できないため、112行目の If Not 文で IsEmpty 関数を使った Empty かどうかの判定が機能しません。そのため 122行目にある Else 以降の処理は絶対に通らないことになります。
検索キーが辞書に登録されてなくても処理を継続したい場合の回避方法として、あらかじめ For 文の前（105行目）に On Error Resume Next を記述する方法があります。
ただ、単に On Error Resume Next を追加しただけだと、直前に代入した動的配列の内容が残ったまま処理が進んでしまいます。これにより検索キーの最後に都道府県コード 48 がある場合、直前の都道府県コード 47 の沖縄県のアイテムが格納されてしまうことになります。
これについては For 文内の一番最初か最後、もしくは 109行目の動的配列にアイテムを代入する直前に ReDim vals2(0) か Erase vals2 を入れて初期化しておくことで一応対策できます。
On Error Resume Next と配列の初期化を組み合わせれば、辞書に存在しない検索キーであってもエラーで止まることはなく、空白のまま処理を進められます。
もう 1つの問題点は 115行目にある 1次元配列の各要素を 2次元配列の各要素に代入する処理です。
今回はデータ件数が少ないため一瞬で処理が終わりますが、これが数万件かつ列数が数十もあると処理がかなり遅くなります。
なぜ、ここまで遅くなるのか原因はわかりませんが、2次元配列 → 2次元配列なら遅くならないこと、1次元配列 → 2次元配列でも各要素が数値（確認した型は通貨のみ）なら遅くならない ことから、1次元配列 → 2次元配列への代入の場合、バリアント型？か 配列の値渡し？ が影響しているのではないかと思っています。
以上の取り上げた問題点の対策方法については改善した VBA コードを用意したので こちら と こちら で紹介します。
連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 2（エラー改善版、大量データ抽出処理×）
連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1 では辞書に登録されていない検索キーで参照すると Empty でエラーが発生しまうというものでした。それを改善したのが以下の VBA サンプルコード 2 です。
どの部分のVBA コードを変更して改善したかについては 次のセクション で説明します。
条件式で Empty を判定してから、動的配列にアイテムを代入
' 変数宣言
Dim key2 As String ' Dictionary 用 Key 変数
Dim vals2() As Variant ' Dictionary 用 Item 変数（動的配列）
' 検索元シートの Key で検索先シートの Item を取得
For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
key2 = data2(i, 1) ' 検索元シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
' vals2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード））と一致した Item を動的配列に格納
' 辞書（myDic）に登録した Key の Empty 判定
If Not IsEmpty(myDic(key2)) Then ' myDic(key2) が Empty ではない場合
vals2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード））と一致した Item を動的配列に格納
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
' 1次元配列から 2次元配列への代入が遅い？
data3(i, k) = vals2(k - 1) ' Item データを配列に格納
Next k
' data3(i, 1) = vals2(0) ' for 文を使わない場合の書き方 - 中身は Item の 都道府県
' data3(i, 2) = vals2(1) ' for 文を使わない場合の書き方 - 中身は Item の Prefectures
' data3(i, 3) = vals2(2) ' for 文を使わない場合の書き方 - 中身は Item の 県庁所在地
' data3(i, 4) = vals2(3) ' for 文を使わない場合の書き方 - 中身は Item の Capital
' data3(i, 5) = vals2(4) ' for 文を使わない場合の書き方 - 中身は Item の 地方区分
Else ' myDic(key2) が Empty の場合
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
Next k
' data3(i, 1) = "*****" ' for 文を使わない場合の書き方
' data3(i, 2) = "*****" ' for 文を使わない場合の書き方
' data3(i, 3) = "*****" ' for 文を使わない場合の書き方
' data3(i, 4) = "*****" ' for 文を使わない場合の書き方
' data3(i, 5) = "*****" ' for 文を使わない場合の書き方
End If
Next i
上記 VBA コードは 連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1 から変更したところを一部抜粋した VBA コードです。
107行目で 辞書（myDic） からキー変数と一致したアイテムを動的配列に格納するコードをコメントアウトにしています。（動的配列に Empty を代入しようとするとエラーになるため）
110行目の If Not 文と IsEmpty 関数でキー変数を使って 辞書（myDic） から参照した場合に Empty かどうかを判定します。VBA サンプルコード 1 では If Not IsEmpty(vals2) Then となっていたところを If Not IsEmpty(myDic(key2)) Then に変更しています。
110行目の判定で Empty でなければ 107行目でコメントアウトした vals2 = myDic(key2) を 111行目で処理するようにします。
以上のように動的配列への Empty 代入エラー対策として、If 文で Empty 判定処理をしてから動的配列へ代入をする処理手順に変更することでエラーを回避できます。
この変更で辞書に登録していない検索キーで参照しても、122行目の Else 以降の処理に進むことになります。ここでは辞書に検索キーに対応したアイテムがなかった場合にアスタリスクを代入しています。
なお 115行目にある 1次元配列の各要素を 2次元配列の各要素に代入すると処理がかなり遅くなる点については、連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1 から変更がありません。この部分を改善した VBA コードを 次のセクション で公開・解説します。
アイテムを格納した1次元配列を 2次元配列に変換してから、2次元配列から 2次元配列へ代入できるように、連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 2 の一部コードを追加・変更した 連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 4 を作成しました。
連想配列（Dictionary オブジェクト）大量データ高速抽出処理 VBA サンプルコード 3（条件エラー改善版、大量データ抽出処理〇）
連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1 と VBA サンプルコード 2 では一つのキーに対して複数のアイテムを配列として辞書登録をした場合、検索キーから複数のアイテムを 1次元配列に代入したところまでであれば、処理速度は問題ありません。
その後、複数のアイテムを格納した 1次元配列の各要素から 2次元配列の各要素に代入した際に、アイテムが多ければ多いほど処理が極端に遅くなります。データ件数が少なければあまり気になりませんが、数万件のデータを処理しようとするとなかなか終わらなくなります。
以下の VBA サンプルコード 3 は VBA サンプルコード 2 の内容を変更して処理時間を改善した内容となっています。なお、VBA サンプルコード 3 の内容はこちらの 動画・情報 とほぼ同じ内容のものとなっています。
VBA コード変更内容については 次のセクション から解説します。
連想配列（Dictionary オブジェクト）へキー・2次元配列行番号（連番）登録
' 変数宣言
Dim myDic As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Set myDic = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Dim key1 As String ' Dictionary 用 Key 変数
Dim row1 As Long ' Dictionary 用 Item 変数（Key がある配列の行番号）
' 検索先シートの Key と Item を Dictionary に登録
For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した検索先シートの 1次元最大要素までループ処理
key1 = data1(i, 1) ' 検索先シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
row1 = i ' Key がある配列の行番号格納
' Key 重複登録判定
If Not myDic.Exists(key1) Then
myDic.Add key1, row1 ' 重複していなければ Key, Item 辞書登録
End If
Next i
こちらの 動画・情報 を参考に、連想配列（Dictionary オブジェクト）を使ってキーとアイテムを辞書登録します。変更点は以下の通りです。
80行目で Variant 型の動的配列から Long 型の変数宣言に変更しています。Variant 型のままでも問題ありませんが、この後に格納する値が数値のみとなっているため、それにあわせて型を変更しているだけです。
85行目で Long 型変数にカウンタ変数の値を代入します。この値は 2次元配列のキーがある行番号に相当します。これが辞書にキーとセットに登録するアイテムになります。
89行目でキーの重複がなければ Dictionary オブジェクトの Add メソッドでキーとアイテムを登録します。
ちなみに myDic.Add key1, i というようにカウンタ変数 i を使ってアイテム登録する方法でも同じ動作になります。この書き方の場合では 80行目の変数宣言と 85行目の変数へ代入するコードは不要です。
以上のように Array 関数を使った 2次元配列の各要素を動的配列に代入してアイテム登録する処理を、2次元配列のキーがある行番号（＝カウンタ変数）をアイテムとして登録する処理に置き換えています。
連想配列（Dictionary オブジェクト）から検索キーを使ってアイテム（2次元配列行番号（連番））取得
' 変数宣言
Dim key2 As String ' Dictionary 用 Key 変数
Dim row2 As Long ' Dictionary 用 Item 変数（Key がある配列の行番号）
' 検索元シートの Key で検索先シートの Item を取得
For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
key2 = data2(i, 1) ' 検索元シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
' 辞書（myDic）から Key を指定して Item を取り出した時の Empty 判定
If Not IsEmpty(myDic(key2)) Then ' myDic(key2) が Empty ではない場合
row2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード）） と一致した Item を変数に格納
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
data3(i, k) = data1(row2, k + 1) ' 配列 data1 の row2 行 k + 1 列目を、配列 data3 の i 行 k 列目に格納
Next k
' data3(i, 1) = data1(row2, 2) ' for 文を使わない場合の書き方 - 中身は「都道府県県庁所在地地方区分ランダム並べ替え」シート 2 列目の都道府県
' data3(i, 2) = data1(row2, 3) ' for 文を使わない場合の書き方 - 中身は「都道府県県庁所在地地方区分ランダム並べ替え」シート 3 列目の Prefectures
' data3(i, 3) = data1(row2, 4) ' for 文を使わない場合の書き方 - 中身は「都道府県県庁所在地地方区分ランダム並べ替え」シート 4 列目の県庁所在地
' data3(i, 4) = data1(row2, 5) ' for 文を使わない場合の書き方 - 中身は「都道府県県庁所在地地方区分ランダム並べ替え」シート 5 列目の Capital
' data3(i, 5) = data1(row2, 6) ' for 文を使わない場合の書き方 - 中身は「都道府県県庁所在地地方区分ランダム並べ替え」シート 6 列目の地方区分
Else ' myDic(key2) が Empty の場合
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
Next k
' data3(i, 1) = "*****" ' for 文を使わない場合の書き方
' data3(i, 2) = "*****" ' for 文を使わない場合の書き方
' data3(i, 3) = "*****" ' for 文を使わない場合の書き方
' data3(i, 4) = "*****" ' for 文を使わない場合の書き方
' data3(i, 5) = "*****" ' for 文を使わない場合の書き方
End If
Next i
キー・アイテム登録した連想配列（Dictionary オブジェクト） から検索キーを使ってアイテム（2次元配列の行番号）を取得します。変更点は以下の通りです。
97行目で Variant 型の動的配列から Long 型の変数宣言に変更しています。Variant 型のままでも問題ありませんが、この後に格納する値が数値のみとなっているため、それにあわせて型を変更しているだけです。
105行目で 辞書（myDic） からキー変数と一致したアイテムを、97行目で宣言した Long 型変数に格納しています。
108行目で、105行目で代入した Long 型変数を行番号として、107行目のカウンタ変数 k + 1 を列番号として（+ 1 は開始列番号調整）、2次元配列 data1 の各要素を、データ格納先 2次元配列 data3 の各要素（i 行 k 列目）に代入します。
以上、辞書から検索キーに対応する目的の複数アイテムを取得する処理方法から、検索キーがある 2次元配列の行番号を辞書から取得する方法に変更しています。辞書登録元の 2次元配列に対して行列番号を指定することで、検索キーに対応する複数のデータを取得できます。
この処理方法のメリットは辞書に複数のアイテムを登録する必要がないので、辞書から検索キーを使って複数のアイテムを 1次元配列への代入が不要、1次元配列の各要素を 2次元配列へ代入するときの処理が遅くなる心配がありません。
連想配列（Dictionary オブジェクト）データ集計用サンプルファイル（xlsx ファイル）
連想配列（Dictionary オブジェクト）データ集計用のサンプルファイル（xlsx ファイル）を公開します。
こちらで作成した 連想配列複数列集計A.xlsx ファイル と 連想配列複数列集計B.xlsx ファイル を用意しました。ファイル名リンクをクリックすると Google ドライブからダウンロードするようにしています。
連想配列複数列集計A.xlsx ファイル は VBA コードを実行する前の状態、連想配列複数列集計B.xlsx ファイル は VBA コード実行後の処理結果内容となっています。
いずれも xlsx ファイルとなっており VBA コードは含まれていません。VBA コードを実行するにはファイル拡張子が xlsm（マクロ有効ブック）となっている必要がありますが、xlsm 形式での配布は念のため避けています。
VBA コードを実行するには 連想配列複数列集計A.xlsx ファイル をダウンロード後 xlsm 形式に保存、Visual Basic Editor（VBE）を起動して参照設定から「Microsoft Scripting Runtime」を設定（事前バインディング） します。以降各セクションで紹介している VBA コードを各自追加して実行してもらう形としています。
VBA コードの追加方法は VBE のプロジェクトエクスプローラー（Ctrl + R キー）画面にて、開いている VBAProject（ファイル名.xlsm）→「標準モジュール」を開き、右クリックから「挿入」→「標準モジュール」でクリック、追加した標準モジュールに VBA コードを貼り付けることで動作できるようにしています。
一部 VBA コード内にある Call ステートメントを使った Function プロシージャの呼び出し については、呼び出し先標準モジュールのプロパティ（F4 キー）画面から（オブジェクト名）欄を設定するのが前提となっています。
集計用サンプルデータの内容は A 列にコード番号 1 ～ 1,000 まで用意、B ～ J 列にまで左隣の列の数値に 10 倍した値を格納（コード番号 1 の場合、B 列は 10、J 列は 1,000,000,000）。K ～ S 列は B ～ J 列の内容をそのまま格納しています。
B ～ J 列までの値は 通貨型 としています。これ以上桁数を増やさなかったのは集計処理の途中でオーバーフローを起こすためです。
このコード番号 1 ～ 1,000 までの B ～ J 列データを 10万行まで繰り返し配置、各コード番号のデータがちょうど 100 個ある計算（100,000 行 ÷ データユニーク個数 1,000 = 各コード番号の個数 100）となります。
上記サンプルデータを、連想配列（Dictionary オブジェクト）を使ってデータを集計処理する VBA サンプルコードを 2つ公開します。どちらの VBA コードを実行しても処理結果は同じになるようにしています。
コード番号別（1 ～ 1,000）に同じ列同士の数値を集計します。集計したデータの反映先がわかりやすいように、あらかじめ該当セルを罫線で囲んでいます。
VBA コードの詳細な内容については各セクション（VBA サンプルコード 1、VBA サンプルコード 2）で説明します。
連想配列（Dictionary オブジェクト）大量データ高速集計処理 VBA サンプルコード 1
以下、連想配列（Dictionary オブジェクト）大量データ高速集計処理 VBA サンプルコード 1 です。処理時間は約 1秒とちょっとです。
基本的に データ抽出処理 VBA サンプルコード 1 と データ抽出処理 VBA サンプルコード 2 とほぼ同じ処理の流れで、キーに対応した複数のデータ抽出から複数の数値集計処理に置き換えた形でのコード内容となっています。
次のセクション から集計処理に関係があるコード部分に絞って内容を説明します。
今回用意したサンプルデータと VBA コードは、番号別に用意した大量のアイテム（複数列）の数値をグループ化してまとめて集計する内容となっています。
ちなみに以下の参考サイトでも連想配列（Dictionary オブジェクト）を使った抽出・集計方法がありますが、核となるコード部分（Enum（列挙型）、2つの Dictionary オブジェクト、クラス）については本記事ではその内容を含めていません。
検証してないので断定はできませんが、参考サイトの内容ではこちらで用意したサンプルデータを処理するのに必要なコードが煩雑になりそうで、こういった処理（大量の列を一気にまとめて取得したり集計すること）には不向きなような気がします。配列と For 文をうまく使えれば何とかなりそうな感じがしますけど、うまくできるかどうか試していないためわかりません。可能だとしてもコード内容がややこしくなりそうです。
ただ、大量のデータの中から特定の列だけを選び、データを抽出・集計するという処理なら適切かもしれません。
連想配列（Dictionary オブジェクト）の辞書登録件数から一時データ格納先 2次元配列作成
Dim myDic1 As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Set myDic1 = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Dim key1 As String ' Dictionary 用 Key 変数
' 重複コードを除いたデータ件数をカウントするための Dictionary 登録処理
' データシートの Key と Item（ダミー）を Dictionary に登録
For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した文字列連結対象シートの 1次元最大要素までループ処理
key1 = data1(i, 1) ' データシート i 行目の 1列目（コード）を Dictionary 用 Key 変数にセット
' Key 重複登録判定
If Not myDic1.Exists(key1) Then
myDic1.Add key1, 1 ' 重複していなければ Key, Item 辞書登録（Key を使ってデータ件数をカウントするため、Item はダミーデータとして 1 に設定）
End If
Next i
' ----------
' シートの指定したセル範囲を配列として格納する動的配列
Dim data2() As Variant
' シートの指定した範囲内セルを配列として動的配列に格納
' Dictionary で登録した Key 登録件数を myDic.Count で呼び出して終点セルの行に指定、始点セルの行は 2 からスタートしているため myDic.Count に + 1 で調整
data2 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic1.Count + 1, maxcol1)).Value
' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
' data2 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic1.Count + 1, maxcol1)))
連想配列（Dictionary オブジェクト）の辞書登録件数から一時データ格納先 2次元配列を作成します。
データ抽出用サンプルデータ では事前に検索キーが判明していたので、一時データ格納先の 2次元配列をあらかじめ作成できましたが、データ集計用サンプルデータ では検索キーがありません。
コード番号別に数値が羅列しているシートから集計するという内容のため、集計後データ格納に必要な 2次元配列の行数がわからない状態となっています。今回のサンプルデータの場合はあらかじめコード番号が 1 ～ 1000 の 1000個と判明しているので、最初から数値を直接指定しての範囲指定は可能ですが、複数の重複するコード番号がランダムで大量に存在する場合は、この時点でのユニークなデータ個数は不明なままとなっています。
列数については一目瞭然で各列が独立していることが判明しているので、2次元配列に必要な列数の取得は問題ありません。
ここでは連想配列（Dictionary オブジェクト）を使って辞書の登録件数から、データを格納するのに必要な 2次元配列の行数を計算して 2次元配列を作成します。別解としてあらかじめ大きな行数を指定しまうというやり方がありコードを短くすることができますが、ここでは必要な分だけを求めて無駄なくぴったり用意するという形で進めます。
辞書登録件数カウントが目的のため、辞書へアイテムの登録は不要です。そのため、Dictionary 用アイテム変数（動的配列）の宣言とアイテムを代入するコード（54行目と 59行目）はありません。
61行目のキー変数の重複判定後、重複がなければ 62行目で Dictionary オブジェクトの Add メソッドでキーとアイテムを登録します。キー登録ができればいいのでアイテムは不要ですが、省略できないのでダミーデータとして適当な値（ここでは 1）を指定しています。
これで番号別に集計した時のデータを格納するのに必要な 2次元配列の行数を求めることができます。
73行目で集計後データ格納先 2次元配列を Range プロパティで作成するときに、Cells プロパティの終点セルに Dictionary オブジェクトの Count プロパティを指定します。終点セルで + 1 とあるのは、開始セルの行番号が 2 からスタートしているため（1行目は見出し）、それにあわせて調整しているためです。
行数があらかじめ判明していれば、73行目の myDic1.Count + 1 の部分に直接数値を入力したり、明らかに足りる数値を入れてしまうやり方も可能です。その場合は 51 ～ 64行目のコードは不要になります。
連想配列（Dictionary オブジェクト）へキー・アイテム（集計対象数値データ）登録と集計処理
' 変数宣言
Dim myDic2 As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Set myDic2 = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Dim key2 As String ' Dictionary 用 Key 変数
Dim vals2() As Variant ' Dictionary 用 Item 変数（動的配列）
Dim sum() As Variant ' Dictionary 用 Item 値合算用変数（動的配列）
' Dim dbg() As Variant ' Dictionary 用 Item 変数（動的配列）デバッグ用
' Dictionary 用 Item 値合算用変数（動的配列）の要素数定義
ReDim vals2(LBound(data1, 2) - 1 To UBound(data1, 2) - 2)
' データシートの Key と Item を Dictionary に登録
For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納したデータシートの 1次元最大要素までループ処理
' データシート i 行目の 1列目（コード）を Dictionary 用 Key 変数にセット
key2 = data1(i, 1)
' Array 関数の要素にデータシート i 行目の 2列目（数値1）～ 19列目（数値18）をセットし、
' Dictionary 用 Item 変数（動的配列）に代入（処理速度次点）
' vals2 = Array(data1(i, 2), data1(i, 3), data1(i, 4), data1(i, 5), data1(i, 6), data1(i, 7), data1(i, 8), data1(i, 9), data1(i, 10) _
' , data1(i, 11), data1(i, 12), data1(i, 13), data1(i, 14), data1(i, 15), data1(i, 16), data1(i, 17), data1(i, 18), data1(i, 19))
' Array 関数を使わずに For 文でデータシート i 行目の 2列目（数値1）～ 19列目（数値18）を Dictionary 用 Item 変数（動的配列）に代入
' 事前に ReDim vals2(LBound(data1, 2) - 1 To UBound(data1, 2) - 2) 定義が必要（処理速度最速）
For k = LBound(data1, 2) - 1 To UBound(data1, 2) - 2
vals2(k) = data1(i, k + 2)
Next k
' ReDim Preserve でカウンタ変数 k を使って要素数変更後、Dictionary 用 Item 変数（動的配列）に代入（処理速度最遅）
' For k = LBound(data1, 2) - 1 To UBound(data1, 2) - 2
' ReDim Preserve vals2(k)
' vals2(k) = data1(i, k + 2)
' Next k
' Key 重複登録判定
If Not myDic2.Exists(key2) Then
myDic2.Add key2, vals2 ' 重複していなければ Key, Item 辞書登録
' Debug.Print key2
' Debug.Print vals2(0)
' Debug.Print vals2(17)
Else ' Key が重複していれば
' 辞書（myDic2）から Key（key2 = data1(i, 1)）と一致した Item（vals2 = Array(data1(i, 2),～, data1(i, 17))）を動的配列 sum に格納
sum = myDic2(key2)
For k = LBound(vals2) To UBound(vals2) ' 動的配列 vals2 の 1次元最大要素（Item）までループ処理
' 動的配列 sum の各要素 k に格納した値に、Key 重複判定で登録できなかった動的配列 vals2 の各要素 k に格納した値を加算
' 計算結果を動的配列 sum の各要素 k に格納
sum(k) = sum(k) + vals2(k)
Next k
myDic2(key2) = sum ' 計算結果を格納した動的配列 sum を辞書（myDic2）に反映
' dbg = myDic2(key2)
' Debug.Print dbg(0)
' Debug.Print dbg(17)
End If
Next i
' dbg = myDic2("1")
' Debug.Print dbg(0)
' Debug.Print dbg(17)
連想配列（Dictionary オブジェクト）を使ってキーとアイテムを辞書登録して番号別に集計します。
集計処理（138 ～ 148行目）以外の部分は データ抽出処理の辞書へのキー・アイテム登録コード とほぼ同じ内容です。
以下のコード説明でアイテム変数に集計対象の数値を代入していますが、その内容は全部で 3種類あります。それぞれコード内容について説明しますが、ここではその中で処理が一番速かったコードを採用、残り 2種類のコードについてはコメントアウトしています。コメントアウトした、いずれの VBA コードも最初から最後まで実行しても 2秒以内で終わるようになっており、コンマ数秒の差しかありません。
1つ目のコード（処理速度最速）は 120 ～ 122行目で For 文を使ってアイテム変数（動的配列）の各要素番号に、集計対象データを格納している 2次元配列 data1 の各列の数値を代入しています。
動的配列の場合、各要素番号に値を代入するために、106行目の ReDim ステートメントで事前に動的配列の要素数を定義しておく必要があります。要素数の定義は直接数値指定でも問題ないですが、ここでは LBound・UBound 関数を使って必要な配列の要素数を調整しています。
106行目の ReDim ステートメントと 120行目の For 文では初期値 To 最終値に、同じ LBound(data1, 2) - 1 To UBound(data1, 2) - 2 を記述しています。
単純に配列の要素数定義・ループ処理をするのであれば LBound(data1, 2) To UBound(data1, 2) - 1 でもいけますが、これだと動的配列の開始要素番号が 1 からとなってしまいます。ここでは動的配列の開始要素番号を 0 を基準にしたかったので、初期値・最終値にさらに - 1 を加えて LBound(data1, 2) - 1 To UBound(data1, 2) - 2 にして調整しています。
カウンタ変数 k の初期値が 1 から 0 になったことで、121行目の動的配列 vals2 の要素番号 k の値を調整することなく、そのまま使うことができています。
2つ目のコード（処理速度次点）はコメントアウトしている 115 ～ 116行目です。これは 従来の Array 関数を使った複数のアイテムを代入する方法 と同じです。
こちら では Array 関数を使った集計がうまくいかなかったようですが、私が作成した VBA コードでは動作確認をしているのでうまく修正すれば動作するのではないかと思われます。
処理速度はわずかに遅く（1つ目の方法と比べると 0.2 ～ 0.3 秒ほど遅い）、登録するアイテム数が多いと入力するコードも多くなる（横に長くなる）のがデメリットです。アイテムに登録する 2次元配列の列を個別に指定できるので、集計対象を自由に選択できる点では便利かもしれません。
ちなみ、2つ目の方法の場合は 106行目の ReDim ステートメントはあってもなくても問題なく処理できます。
最後 3つ目のコード（処理速度最遅）はコメントアウトしている 125 ～ 128行目です。コード自体は 1つ目の 120 ～ 122行目と同じですが、For 文内の最初に ReDim Preserve vals2(k) を入れています。これを入れることで 106行目の ReDim ステートメントで要素数を定義しなくても、カウンタ変数 k で ReDim Preserve で動的配列の要素数を都度拡張していくことで、値の保持と代入を可能としています。
ただ、1つのキーに対して代入する値の列数分だけ毎回 ReDim Preserve を実行するためか、処理速度は 3つのコードの中では一番遅かったです。それでも 1つ目の方法と比べてせいぜい 0.5 秒程度ぐらいの差しかなくそこまで遅くはありませんでした。
次に各番号別集計処理について。
131行目の If Not 文と Dictionary オブジェクトの Exists メソッドでキーの重複判定を行い、すでにキーが登録されていたら 138行目の Else に飛んで値の集計処理をします。
140行目で辞書（myDic2）から Key（111行目で data1(i, 1) を代入した変数 key2）と一致した Item（配列 vals2）を動的配列 sum に格納します。
142行目で For 文とカウンタ変数 k で動的配列 vals2 の 1次元最大要素までループ処理します。
145行目で動的配列 sum の各要素 k に格納した値に、Key 重複判定で登録できなかった動的配列 vals2 の各要素 k に格納した値を加算します。加算後、計算結果を動的配列 sum の各要素 k に戻します。
148行目で計算結果を格納した動的配列 sum を辞書（myDic2）に反映します。（140行目のコード、右辺左辺を逆配置）
以上が連想配列（Dictionary オブジェクト）を使った番号別集計処理の流れです。
連想配列（Dictionary オブジェクト）からキー・アイテム（集計した数値データ）取得
' 変数宣言
Dim key3 As Variant ' 辞書（myDic2）に登録したキーを格納するバリアント型変数宣言（なお、動的配列 key3() だとエラー）
Dim vals3() As Variant ' Dictionary 用 Item 変数（動的配列）
' 配列 data2 行番号用変数初期値設定
i = 1 ' 1行目
For Each key3 In myDic2.Keys ' For Each...Next ステートメントを使って、Keys メソッドで辞書（myDic2）に登録したキーを取得
data2(i, 1) = key3 ' 配列 data2 の i 行 1 列目に配列 key3（コード）を代入
vals3 = myDic2(key3) ' 辞書（myDic2）から Key（key3）と一致した Item を動的配列に格納
For k = LBound(data2, 2) + 1 To UBound(data2, 2) ' 2列目から 2次元最大要素（Item）までループ処理
data2(i, k) = vals3(k - 2) ' Item データを配列に格納
Next k
i = i + 1 ' 配列 data2 行番号用変数 i を次の行へインクリメント（+1）
Next key3
連想配列（Dictionary オブジェクト）からキー・アイテム（集計した数値データ）を取得して 2次元配列に格納します。
基本的な処理の流れは 検索キーを使った辞書からのアイテム抽出処理コード とほぼ同じで、一部コード内容を変更しています。
171行目では こちらの情報 を参考に For Each Next ステートメントを使って、Keys メソッドで辞書（myDic2）に登録したキーを取得します。辞書から取得した各キーを 165行目で宣言したバリアント型変数 key3 に順番に格納させて、キーの最後までループ処理します。Keys メソッドを省略した For Each key3 In myDic2 という書き方でも同様に処理できます。
ちなみに 165行目で宣言したバリアント型変数 key3 についてですが、動的配列 key3() と宣言して For Each Next ステートメントで使うとエラーになります。
For Each Next ステートメント内ではデータ格納先 2次元配列 data2 の各要番号に、キーと集計した値を格納します。
データ格納先 2次元配列 data2 の行番号の指定にはカウンタ変数 i を使用します。
まず、169行目で 2次元配列の行番号の初期値 1 をカウンタ変数 i に代入して設定します。
以降、For Each Next ステートメント内でカウンタ変数 i を使って 2次元配列 data2 の各要素番号にキー・集計値を格納後、180行目でカウンタ変数 i をインクリメント（+1）して次の 2次元配列の行番号を指定しています。
173行目でキーを格納した変数 key3 を 2次元配列 data2(i, 1) に格納します。
174行目と176 ～ 178行目は 検索キーを使った辞書からのアイテム抽出処理コード とほぼ同じです。
174行目で 辞書（myDic2）からキー変数と一致したアイテムを動的配列に格納します。
176行目で For 文・カウンタ変数・LBound・UBound 関数で、データ格納先 2次元配列 data2 の 2次元（列相当）の最小 + 1 ～最大要素までループします。この中の LBound 関数で + 1 をしているのは、173行目ですでにキーを 2次元配列の 1列目に代入しているため、2列目から開始するようにしているためです。
177行目でカウンタ変数 k を使って動的配列 vals3 の各要素番号を指定、同じくカウンタ変数 i と k を使ってデータ格納先 2次元配列 data2 に代入します。この中で vals3(k - 2) とカウンタ変数 k に - 2 をしているのは、176行目のカウンタ変数 k の開始値が LBound(data2, 2) + 1 の場合 2 となり、1次元配列の開始要素番号は 0 からスタートするため、vals3(0) から始まるように vals3(2 - 2) にして調整しているためです。
以上が連想配列（Dictionary オブジェクト）から番号別に集計した数値データの取得処理の流れです。
177行目では 1次元配列の各要素を 2次元配列の各要素に代入する処理をしていますが、アイテム抽出処理 ではデータ数が多くなって代入が多くなると 処理が極端に遅くなる という問題を抱えていました。
今回用意したサンプルデータでは特にそのような問題は確認できなかったので理由はわかりませんが、1次元配列から 2次元配列への代入対象が数値（今回は通貨型）のみだったので、配列に格納したデータ型が数値型だけであれば処理速度はあまり影響が出ないのかもしれません。
連想配列（Dictionary オブジェクト）大量データ高速集計処理 VBA サンプルコード 2
以下、連想配列（Dictionary オブジェクト）大量データ高速集計処理 VBA サンプルコード 2 です。処理時間は 2 秒かからないくらいです。
こちらの情報 を参考に、データ集計処理 VBA サンプルコード 1 の一部の処理を変更して作成した VBA コードです。
データ集計処理 VBA サンプルコード 1 からの大きな変更点として Dictionary オブジェクトを配列化している点です。
次のセクション から集計処理があるコード部分に絞って内容を説明します。
連想配列（Dictionary オブジェクト配列化）へキー・アイテム（数値データ集計）登録
' Dim dbg As Currency ' Dictionary 用 Item 変数（動的配列）デバッグ用
' Dictionary 型配列宣言
Dim myDic2() As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
ReDim myDic2(LBound(data1, 2) To UBound(data1, 2) - 1) ' 集計対象列数分の要素数定義
For i = LBound(data1, 2) To UBound(data1, 2) - 1 ' 集計対象列数分ループ処理
Set myDic2(i) = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
Next i
Dim key2 As String ' Dictionary 用 Key 変数
Dim vals2() As Variant ' Dictionary 用 Item 変数（動的配列）
' データシートの Key と Item を Dictionary に登録
For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納したデータシートの 1次元最大要素までループ処理
' データシート i 行目の 1列目（コード）を Dictionary 用 Key 変数にセット
key2 = data1(i, 1)
' Key 重複登録判定
If Not myDic2(1).Exists(key2) Then
For k = LBound(data1, 2) To UBound(data1, 2) - 1 ' 集計対象列数分ループ処理
myDic2(k).Add key2, data1(i, k + 1) ' 重複していなければ Key, Item 辞書登録
' Debug.Print key2
' Debug.Print data1(i, k + 1)
Next k
Else ' Key が重複していれば
For k = LBound(data1, 2) To UBound(data1, 2) - 1 ' 集計対象列数分ループ処理
myDic2(k)(key2) = myDic2(k)(key2) + data1(i, k + 1) ' 集計
' Debug.Print myDic2(k)(key2)
' Debug.Print data1(i, k + 1)
Next k
End If
Next i
' dbg = myDic2(1)("1")
' Debug.Print dbg
100行目で Dictionary 型のオブジェクト変数の宣言をしていますが、変数名の後ろに () を入れて動的配列としています。
100行目で宣言した Dictionary 型動的配列の変数を、101行目で LBound・UBound 関数を使って辞書登録対象の 2次元配列 data1 の 2次元最大要素（列相当）までの要素数 - 1（集計対象列数すべて）を定義しています。今回のサンプルデータの場合ですと、B ～ S 列まであるので ReDim myDic2(1 To 18) ということになっています。
103行目の For 文と LBound・UBound 関数で、辞書登録対象の 2次元配列 data1 の 2次元最大要素（列相当）までループ処理します。
104 行目の For 文内で Dictionary 型動的配列のすべての要素番号に対して、Dictionary オブジェクトのインスタンスを生成しています。
これまでは 1つしか生成しなかった Dictionary オブジェクトを、集計対象の列数分だけ用意している点が今までと異なっている点です。
116行目のキー重複判定では Dictionary 型動的配列の要素番号 1（myDic2(1)）を基準にして、If Not myDic2(1).Exists(key2) Then で判定をしています。myDic2(1) は 配列化した Dictionary オブジェクトからキー・アイテム（集計した数値データ）を取得 するときにも利用します。
キーの重複がなければキーとアイテム登録のため、117 行目で LBound・UBound 関数を使ってキーを除く集計対象の列数分ループ処理してます。列数分ループ処理させるのが目的なので、2次元配列 data1 の 2次元最大要素（列相当）に - 1 をすることでキーを除く集計対象列数を求めています。
117行目の For 文内では、118行目で Dictionary 型動的配列の各要素番号をカウンタ変数 k で指定、Add メソッドでキーとアイテムを登録します。
キーが重複している場合は 117行目の For 文を 125 行目でループ処理のためそのまま流用して、126行目で数値の集計処理をします。
126行目、右辺の Dictionary 型動的配列の各要素番号（カウンタ変数 k で指定）にキーを指定（myDic2(k)(key2)）することでアイテム（ここでは数値）を呼び出すことができるので、これに重複で登録できなかった 2次元配列 data1 対象列の数値を加算します。それを右辺で登場した myDic2(k)(key2) を再び左辺に記述することで代入することができるので、これを繰り返すことで集計できるようになっています。
以上が配列化した Dictionary オブジェクト（連想配列）を使った番号別集計処理の流れです。
連想配列（Dictionary オブジェクト配列化）からキー・アイテム（集計した数値データ）取得
' 変数宣言
Dim key3 As Variant ' 辞書（myDic2）に登録したキーを格納するバリアント型変数宣言（なお、動的配列 key3() だとエラー）
Dim vals3() As Variant ' Dictionary 用 Item 変数（動的配列）
' 配列 data2 行番号用変数初期値設定
i = 1 ' 1行目
For Each key3 In myDic2(1).Keys ' For Each...Next ステートメントを使って、Keys メソッドで辞書（myDic2）に登録したキーを取得
data2(i, 1) = key3 ' 配列 data2 の i 行 1 列目に配列 key3（コード）を代入
For k = LBound(data2, 2) To UBound(data2, 2) - 1 ' 2列目から 2次元最大要素（Item）までループ処理
data2(i, k + 1) = myDic2(k)(key3) ' Item データを配列に格納
Next k
i = i + 1 ' 配列 data2 行番号用変数 i を次の行へインクリメント（+1）
Next key3
連想配列（Dictionary オブジェクト）からキー・アイテム（集計した数値データ）を取得して 2次元配列に格納します。
基本的な処理の流れは 検索キーを使った辞書からのアイテム（集計した数値データ）取得処理コード とほぼ同じで、一部コード内容を変更しています。
148行目で For Each Next ステートメントを使って、Dictionary 型動的配列の要素番号 1（myDic2(1)）を Keys メソッドで、辞書に登録したキーを取得します。辞書から取得した各キーを 142行目で宣言したバリアント型変数 key3 に順番に格納させて、キーの最後までループ処理します。Keys メソッドを省略した For Each key3 In myDic2(1) という書き方でも同様に処理できます。
152行目で For 文・カウンタ変数・LBound・UBound 関数で、データ格納先 2次元配列 data2 の 2次元（列相当）の最小～最大要素 - 1 までループします。この中の UBound 関数で - 1 をしているのは、配列化した Dictionary オブジェクトへのキー・アイテム（数値データ集計）登録 した時の 117行目と 125行目と同じで、列数分ループ処理させるのが目的です。2次元配列 data1 の 2次元最大要素（列相当）に - 1 をすることでキーを除く集計対象列数を求めています。
177行目で Dictionary 型動的配列の各要素番号 k（カウンタ変数）の変数 key3 に格納したキー（myDic2(k)(key3)）に対応するアイテムの値を、同じくカウンタ変数 i と k + 1 を使ってデータ格納先 2次元配列 data2 に代入します。
この中で data2(i, k + 1) と列番号に割り当てたカウンタ変数 k に + 1 をしているのは、150行目のデータ格納先 2次元配列 data2 の i 行 1列目にキーを代入しているため、同じ列の要素番号に再度値を代入しないように + 1 をしてずらして調整しているためです。
以上が配列化した Dictionary オブジェクト（連想配列）から番号別に集計した数値データの取得処理の流れです。
処理速度に関して、集計対象の列数分だけ Dictionary オブジェクトの配列化を行い、配列化した各 Dictionary オブジェクトへキーと各列のアイテムを 1 対 1 で登録、キーの重複判定で重複したら配列化した各 Dictionary オブジェクトからアイテムを呼び出して集計するという処理のコード内容となっているためか、キーと複数アイテム（集計対象数値データ）をまとめて辞書登録・一気に集計する VBA サンプルコード 1 と比べると、わずかに遅い（差は 1秒以下）です。代わり辞書登録件数カウントが不要、キー・アイテムの登録と集計部分のコードがシンプルになっているので、あまりごちゃごちゃせずすっきりしています。
連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 4（エラー改善版、大量データ抽出処理？）
以下、データ抽出処理 VBA サンプルコード 2 の 1次元配列から 2次元配列へ代入する処理部分を別の方法で書き直した、連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 4 です。
こちらの VBA コード を使って、辞書のアイテムを格納した 1次元配列を 2次元配列に変換する処理を加えています。
1次元配列から 2次元配列への代入する際に発生する処理速度が遅くなる問題については データ抽出処理 VBA サンプルコード 3 で改善版コードを作成しましたが、1次元配列を 2次元配列に変換するモジュールを公開 しているところを見つけたので、このコードを使うことでも配列に関する処理問題を改善できるかもしれません。
ただ、動作確認は取れていますが、大量のデータを使った処理速度計測・比較はしていません。そのため、大量のデータに対して実用的な時間内で処理が終わるかどうかについては未確認です。
次のセクション では 1次元配列を 2次元配列に変換しているコード部分について説明します。
1次元配列を 2次元配列に変換
Option Explicit
Public Function Call_ArrayTo2DArray(arr As Variant, col As Long) As Variant
' 一次元配列を二次元配列に変換
' 参考記事 一次元配列を二次元配列に変換する【ExcelVBA】 https://vba-create.jp/vba-array-to-2d-array/
Dim buf() As String: ReDim buf(UBound(arr), col)
Dim i As Long
For i = LBound(arr) To UBound(arr)
buf(i, LBound(arr)) = arr(i)
Next i
Call_ArrayTo2DArray = buf
End Function
上記 VBA コードは VBA Create さんのところで公開されている 1次元配列を 2次元配列変換モジュール です。コード内容はそのままですが、こちら の時と同様に部品化のため別の標準モジュールに登録しています。
関数を呼び出せるようにするため、自作関数を登録した標準モジュールのプロパティ（F4 キー）画面から（オブジェクト名）欄を設定（名前は任意）します。ここでは関数名と同じ Call_ArrayTo2DArray に設定して話を進めます。
関数呼び出しの際に関数名とプロパティのオブジェクト名を使用します。（参考情報）
' 変数宣言
Dim key2 As String ' Dictionary 用 Key 変数
Dim vals2() As Variant ' Dictionary 用 Item 変数（動的配列）
Dim vals3 As Variant ' Dictionary 用 Item 変数（配列）
' 検索元シートの Key で検索先シートの Item を取得
For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
key2 = data2(i, 1) ' 検索元シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
' vals2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード））と一致した Item を動的配列に格納
' 辞書（myDic）に登録した Key の Empty 判定
If Not IsEmpty(myDic(key2)) Then ' myDic(key2) が Empty ではない場合
vals2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード））と一致した Item を動的配列に格納
vals3 = Call_ArrayTo2DArray.Call_ArrayTo2DArray(vals2, 0) ' 1次元配列を 2次元配列に変換
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
' 1次元配列から 2次元配列への代入が遅い？
' data3(i, k) = vals2(k - 1) ' Item データを配列に格納
data3(i, k) = vals3(k - 1, 0) ' 1次元配列から 2次元配列に変換した vals3 の Item データを 2次元配列に格納
Next k
' data3(i, 1) = vals2(0) ' for 文を使わない場合の書き方 - 中身は Item の 都道府県
' data3(i, 2) = vals2(1) ' for 文を使わない場合の書き方 - 中身は Item の Prefectures
' data3(i, 3) = vals2(2) ' for 文を使わない場合の書き方 - 中身は Item の 県庁所在地
' data3(i, 4) = vals2(3) ' for 文を使わない場合の書き方 - 中身は Item の Capital
' data3(i, 5) = vals2(4) ' for 文を使わない場合の書き方 - 中身は Item の 地方区分
Else ' myDic(key2) が Empty の場合
For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
Next k
' data3(i, 1) = "*****" ' for 文を使わない場合の書き方
' data3(i, 2) = "*****" ' for 文を使わない場合の書き方
' data3(i, 3) = "*****" ' for 文を使わない場合の書き方
' data3(i, 4) = "*****" ' for 文を使わない場合の書き方
' data3(i, 5) = "*****" ' for 文を使わない場合の書き方
End If
Next i
Call_ArrayTo2DArray 関数 を使って 1次元配列を 2次元配列に変換するコードを追加して一部のコードを変更します。
104行目で新たに変数 vals3 を Variant 型で宣言、これを配列用変数として使います。この変数に Call_ArrayTo2DArray 関数を使って 1次元配列から 2次元配列に変換したデータを格納します。動的配列として宣言すると 114行目の Call_ArrayTo2DArray 関数結果格納時にエラーになるため、変数名に () を入れていません。
114行目で Call_ArrayTo2DArray 関数を呼び出します。
標準モジュールのオブジェクト名の後にドットを入力（Call_ArrayTo2DArray.）すると、インテリセンスで標準モジュールに登録した自作関数名が表示（Call_ArrayTo2DArray.Call_ArrayTo2DArray）されます。ここではオブジェクト名と自作関数名は同じにしています。
Call_ArrayTo2DArray 関数の第 1引数に 113行目で 辞書（myDic） からキー変数と一致したアイテムを格納した動的配列 vals2 を、第 2引数には変換後の 2次元（列相当）の要素数を数値で指定します。
すでに 1次元配列にデータが格納されている状態のため 1列で十分ですが、第 2引数には 0 を指定しています。これは変換前の 1次元配列の最小要素番号が 0 からとなっており、Call_ArrayTo2DArray 関数で 2次元配列に変換する際にも、あわせて開始要素番号を 0 からスタートして 2次元（列相当）の要素数を決める必要があるためです。
開始要素番号 0 から要素数 1 を作成する場合は 0 to 0 という書き方になるので、第 2引数には 0 を指定するということになります。
Call_ArrayTo2DArray 関数で 二次元配列に変換後、104行目で宣言した変数 vals3 に格納します。
118行目の辞書から抽出してアイテムデータを格納した 1次元配列 vals2 から 2次元配列 data3 へ格納するコードをコメントアウト。代わりに 119行目に、114行目にアイテムデータを格納した 2次元配列 vals3 を使って、2次元の要素番号 0 に固定したうえで、1次元の各要素番号にあるアイテムデータを 2次元配列 data 3 に格納します。
