今回は、Dictionary(連想配列)の使い方を説明いたします。連想配列を理解する事で、重複の無いリストを作る方法やデータを配列に登録したデータを簡単に集計する事も出来ます。それでは、順番にサンプルプログラムを交えて説明いたします。
●配列の使い方(Array LBound UBound)の基礎については、下記を参照して下さい。
●2次元配列・セル範囲の内容を配列に格納・配列の内容をセルに代入（一括・高速化・セルの指定範囲）については、下記を参照して下さい。
●連想配列の応用：クロス集計表等は下記を参照してください。
● Dictionaryオブジェクトを利用するには、下記の通りに設定を行います。
Dim 連想配列名 As Object
Set 連想配列名 ＝ CreateObject(“Scripting.Dictionary”)
格納されるデータをキー・アイテムのペアを保持するオブジェクトです。配列として登録されるインデックス番号は、０～１・２・３・・・と整数で順番に割り当てられます。
【Dictionaryメゾット】
| メゾット | 説明（内容） |
|---|---|
| Add | Dictionary オブジェクトに新しいキー/アイテムのペアを追加します。（登録するデータは、キー・アイテム一緒に登録します。キーのみでも登録可能） |
| Exists | 指定したキーが Dictionary オブジェクト内に同じデータが存在するかどうかを返します。（存在する場合は、True 存在しない場合は、False を返す） |
| Items | オブジェクト内のすべてのアイテム（Items）の配列を返します。アイテムの場合は、データ重複しても大丈夫です。 |
| Keys | オブジェクト内のすべてのキー（Keys）の配列を返します。キー（Keys）については、重複したキーを登録するは出来ません。 |
| Remove | オブジェクトから、指定したキー/アイテムの選択したペアを削除します。 |
| RemoveAll | オブジェクト内の全てのキー/アイテムのペアを削除します。（登録したデータがクリアされます。） |
【Dictionaryプロパティ】
| プロパティ | 説明（内容） |
|---|---|
| CompareMode | Dictionary オブジェクト内でキーを比較するために比較モードを設定するか返します。キーを比較する際にあいまい検索を許可するか指定します。 定数：BinaryCompare 文字の全角・半角を区別します。 定数：TextCompare 文字の全角・半角を区別しません。 |
| Count | オブジェクト内のキー/アイテムのペアの数を返します。 |
| Item | オブジェクト内のアイテムの値を設定するか返します。 |
| Key | オブジェクト内の既存のキー値に対して新しいキー値を設定します。 |
【使用例】
'
Sub Dictionary00() '連想配列サンプル
Dim Dict As Object '連想配列名の設定（配列名：Dict）
Dim I As Integer
Set Dict = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクトを設定します。（配列名：Dict）
Dict.Add "日本", "Tokyo" '設定した連想配列に登録します。（キーは、日本 アイテムは、Tokyo）
MsgBox Dict("日本") 'キーを指定（日本）して、該当するアイテムを表示します。
Set Dict = Nothing '配列参照の解除
End Sub
' 【実行後】
【注意点】
登録するキー(Key)については、同じ文字列等で重複の登録は、出来ません。アイテム（Item）については、同じ文字列での登録は可能です。
下記のサンプルプログラムは、連想配列の登録方法と登録した連想配列データとメッセージボックスに表示する方法を説明いたします。
【プログラムの説明・処理手順】
① 1件目のデータ登録 “日本”, “Tokyo”
② ２件名のデータ登録 ”米国”, “Washington D.C”
③ ３件名のデータ登録 ”英国”, “London”
④ 登録されたデータをメッセージボックスに順番に表示します。
'
'******** AKIRA55.COM ******* https://akira55.com/associative_array_ki/
'
Sub Dictionary01() '登録した連想配列データをメッセージボックスに表示します。
Dim Dict As Object '連想配列名の設定（配列名：Dict）
Dim keys
Dim I As Long
Set Dict = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクトを設定します。（配列名：Dict）
Dict.Add "日本", "Tokyo" '1件目のデータを登録
Dict.Add "米国", "Washington D.C" '2件目のデータを登録
Dict.Add "英国", "London" '3件目のデータを登録
keys = Dict.keys'キーの一覧を取得する。
For I = 0 To Dict.Count - 1 '配列データの0～2まで繰り返す。（配列のスタートは０から：Count登録件数３なので、－１）
MsgBox "Keys=" & keys(I) & " Item=" & Dict.Item(keys(I)) 'メッセージボックスに登録したキー・アイテムを表示します。
Next I
Set Dict = Nothing
End Sub
'
下記のサンプルプログラムは、A列の「勘定科目」が重複登録されています。このA列のデータを元に、B列に重複されていない勘定科目データを表示するサンプルプログラムです。
【プログラム説明・処理手順】
①A列のデータ（勘定科目）を全て読み取ります。
②A列のデータを1件ずつ確認して既に登録されていないかを確認
（新規の場合は、辞書登録（配列に登録）・既に登録されている場合は、何もしない）
③辞書登録（配列に登録）されている一覧データをB列に転記します。
'
' '******** AKIRA55.COM ******* https://akira55.com/associative_array_ki/
'
Sub Dictionary02() '重複データの削除
Dim Dict As Object
Dim keys()
Dim I, lRow As Long
Dim tmp As String
Set Dict = CreateObject("Scripting.Dictionary")
lRow = Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得
For I = 2 To lRow 'A列の最終行まで重複データをチェック（繰り返す）
tmp = Cells(I, "A").Value 'A列のデータ（１件分）Tmpへ代入
If Not Dict.Exists(tmp) Then '重複データをチェック
Dict.Add tmp, "" '重複データが無ければ、辞書登録（配列）
End If
Next I
keys = Dict.keys 'キー(辞書登録)の一覧を取得する。
For I = 0 To Dict.Count - 1 '辞書登録された件数分繰り返します。
Cells(I + 2, "B").Value = keys(I) 'B列へ辞書登録（配列）データを順番に転記します。
Next I
Set Dict = Nothing
End Sub
’
下記のサンプルプログラムは、上記のサンプル②と同じ重複データを削除するサンプルプログラムです。今回のサンプルプログラムは、キーとアイテムに部分にデータを登録を行い、キーデータ部分に対して重複データの削除を行います。
A列の「銀行コード」が重複登録されています。このA列のデータを元に、D列に重複データの無い「銀行コード」データ（キー）とアイテム部分「銀行名」をE列に表示させます。
【プログラム説明・処理手順】
①A列のデータ（キー）「銀行コード」とB列のデータ（アイテム）「銀行名」部分を全て読み取ります。
②A列のデータ（キー）「銀行コード」を1件ずつ確認して既に登録されていないかを確認
（新規の場合は、辞書登録（配列に登録（追加））・既に登録されている場合は、何もしない）
③辞書登録（配列に登録）されている一覧データをD列（キー）「銀行コード」・E列（アイテム）「銀行名」を転記します。
【連想配列の登録（追記）について】
※データを配列（連想配列）として登録する際は、A列のキー（銀行コード）とB列のアイテム（銀行名）を同時に登録（追加）します。
※キー部分は、重複登録不可
※アイテム部分は、重複登録可能
'
'******** AKIRA55.COM ******* https://akira55.com/associative_array_ki/
'
Sub Dictionary03() '重複データの削除(キー、アイテム）表示
Dim Dict As Object
Dim keys()
Dim I, lRow As Long
Dim tmp01, tmp02 As String
Set Dict = CreateObject("Scripting.Dictionary")
lRow = Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得
For I = 2 To lRow 'A列の最終行まで繰り返す。
tmp01 = Cells(I, "A") 'A列の該当セルデータを「tmp01」へ代入
tmp02 = Cells(I, "B") 'B列の該当セルデータを「tmp02」へ代入
If Not Dict.Exists(tmp01) Then '重複データをチェック
Dict.Add tmp01, tmp02 '重複データが無ければ、辞書登録（配列）Keyは、Tmp01 Itemは、Tmp02で追加登録
End If
Next I
keys = Dict.keys'キー・アイテム(辞書登録)の一覧を取得する。
For I = 0 To Dict.Count - 1 '辞書登録された件数分繰り返します。
Cells(I + 2, "D") = keys(I) 'D列へ辞書登録（キー）データを順番に転記します。
Cells(I + 2, "E") = Dict.Item(keys(I)) 'E列へ辞書登録（アイテム）データを順番に転記します。
Next I
Set Dict = Nothing
End Sub
'
下記のサンプルプログラムは、選択したデータを読み取り、重複データ（勘定科目）の削除を行い、勘定科目ごとに金額を集計するサンプルプログラムです。
【プログラム説明・処理手順】
①B列のデータ（キー）「勘定科目」を全て順番に読み取ります。
②B列のデータ（キー）「勘定科目」を1件ずつ確認して既に登録されていないかを確認します。
【新規登録の場合】
・新規の場合は、辞書登録（配列に登録・追加））F列に勘定科目とG列に金額をセルに記入します。
【既に登録されている場合】
・既に登録されている場合は、F列に登録されている勘定科目と同じ行に、金額を加算します。
③最後まで、データを順番に読み取り終わったら、F列・G列の1行目に項目名（勘定科目：合計金額）を付けます。
④F列・G列の最終行に合計値を記入して、集計された勘定科目範囲に、囲線を引きます。
'
'******** AKIRA55.COM ******* https://akira55.com/associative_array_ki/
'
Sub Dictionary04() '勘定科目一覧データから勘定科目毎に集計します。
Dim Dict As Object
Dim Account, Number
Dim I, L, lRow, Total As Long
Set Dict = CreateObject("Scripting.Dictionary")
L = 2 '勘定科目合計の開始行
Total = 0 '合計クリア
Range("F:G").Clear ' 勘定科目の合計値をクリアします。
lRow = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を取得
For I = 2 To lRow
Account = Cells(I, "B").Value 'B列の勘定科目を順番に代入
Number = Cells(I, "C").Value 'C列の金額を順番に代入
If Dict.Exists(Account) Then '勘定科目の重複確認（既に有る場合は、同じ勘定科目で金額集計）
Cells(Dict.Item(Account), "G").Value = Cells(Dict.Item(Account), "G").Value + Number
Else
'勘定科目の確認（無い場合は、勘定科目と合計額の行番号を登録します。
Dict.Add (Cells(I, "B").Value), L
Cells(L, "F").Value = Account '勘定科目を新規登録
Cells(L, "G").Value = Number '金額を新規登録
L = L + 1 '勘定科目・合計額の行を加算する。
End If
Total = Total + Number '全ての金額を加算して合計額を襲名します。
Next I
lRow = Cells(Rows.Count, "G").End(xlUp).Row 'G列の最終行を取得
Range("F1:G1").Interior.ColorIndex = 6 '背景色を黄色に設定（セルF1：G1）
Cells(1, "F") = "勘定科目"
Cells(1, "G") = "合計金額"
Cells(lRow + 1, "G").Value = Total: Cells(lRow + 1, "F").Value = "合計" '集計した合計額を合計表の最終行に代入します。
With Range("G1").CurrentRegion 'G1から始まる表を自動的に選択
.Borders.LineStyle = xlContinuous '囲線を選択
End With
Set Dict = Nothing
End Sub
'
下記のサンプルプログラムは、選択したデータを読み取り、重複データ（勘定科目）の削除を行い、勘定科目ごとに金額を集計するサンプルプログラムです。全体的な処理内容は、サンプル④と同じような作りですが、今回は、集計方法を「支店名＋勘定科目」の組み合わせで集計を行い、結果を別シートに作成します。
【プログラム説明・処理手順】
①ワークシート「データ一覧」・B列のデータ（キー）「支店名」＋「勘定科目」を全て順番に読み取ります。
②ワークシート「データ一覧」・B列のデータ（キー）「支店名」＋「勘定科目」を1件ずつ確認して既に登録されていないかを確認します。
【新規登録の場合】
・新規の場合は、辞書登録（配列に登録・追加））ワークシート「合計表」・F列に勘定科目とG列に金額をセルに記入します。
【既に登録されている場合】
・既に登録されている場合は、ワークシート「合計表」・F列に登録されている「支店名＋勘定科目」と同じ行に、金額を加算します。
③最後まで、データを順番に読み取り終わったら、F列・G列の1行目に項目名（支店名＋勘定科目：合計金額）を付けます。
④F列・G列の最終行に合計値を記入して、集計された勘定科目範囲に、囲線を引きます。
【プログラム実行条件】
ワークシート名・・・「データ一覧」には、A列「支店名」・B列「勘定科目」・C列「金額」
ワークシート名・・・「合計表」
'
'******** AKIRA55.COM ******* https://akira55.com/associative_array_ki/
'
Sub Dictionary05() '勘定科目一覧データから支店名・勘定科目ごと、別シートに集計します。
Dim Dict As Object
Dim ws01, ws02 As Worksheet
Dim Account, Number
Dim I, L, lRow, Total As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set ws01 = Worksheets("データ一覧")
Set ws02 = Worksheets("合計表")
L = 2 '勘定科目合計の開始行
Total = 0 '合計クリア
ws02.Range("F:G").Clear ' 勘定科目の合計値をクリアします。
With ws01
lRow = .Cells(Rows.Count, "B").End(xlUp).Row 'ワークシート「データ一覧」B列の最終行を取得
For I = 2 To lRow
Account = .Cells(I, "A").Value & "-" & .Cells(I, "B").Value '★A列の支店名とB列の勘定科目を順番に代入
Number = .Cells(I, "C").Value 'C列の金額を順番に代入
If Dict.Exists(Account) Then '勘定科目の重複確認（既に有る場合は、同じ勘定科目で金額集計）
ws02.Cells(Dict.Item(Account), "G").Value = ws02.Cells(Dict.Item(Account), "G").Value + Number
Else
'勘定科目の確認（無い場合は、支店名と勘定科目と合計額の行番号を登録します。
Dict.Add (.Cells(I, "A").Value & "-" & .Cells(I, "B").Value), L '★
ws02.Cells(L, "F").Value = Account '支店名と勘定科目を新規登録
ws02.Cells(L, "G").Value = Number '金額を新規登録
L = L + 1 '勘定科目・合計額の行を加算する。
End If
Total = Total + Number '全ての金額を加算して合計額を襲名します。
Next I
End With
With ws02
lRow = .Cells(Rows.Count, "G").End(xlUp).Row 'ワークシート「合計表」G列の最終行を取得
.Range("F1:G1").Interior.ColorIndex = 6 '背景色を黄色に設定（セルF1：G1）
.Cells(1, "F") = "各支店-勘定科目"
.Cells(1, "G") = "合計金額"
.Cells(lRow + 1, "G").Value = Total: .Cells(lRow + 1, "F").Value = "合計" '集計した合計額を合計表の最終行に代入します。
.Range("F1:G" & lRow + 1).Borders.LineStyle = xlContinuous '合計表に罫線を引きます。
.Range("F" & lRow + 1 & ":G" & lRow + 1).Interior.ColorIndex = 8 '背景色を黄色に設定（合計行に背景色）
End With
Set Dict = Nothing
End Sub
'
