EXCEL VBA 連想配列で合計・グループ集計・別シート転記・重複削除 (Scripting.Dictionary)
EXCEL VBA 連想配列で合計・グループ集計・別シート転記・ 重複削除(Scripting.Dictionary)
今回は、Dictionary(連想配列)の使い方を説明いたします。連想配列を理解する事で、重複の無いリストを作る方法やデータを配列に登録したデータを簡単に集計する事も出来ます。それでは、順番にサンプルプログラムを交えて説明いたします。
●配列の使い方(Array LBound UBound)の基礎については、下記を参照して下さい。
●2次元配列・セル範囲の内容を配列に格納・配列の内容をセルに代入（一括・高速化・セルの指定範囲）については、下記を参照して下さい。
●連想配列の応用：クロス集計表等は下記を参照してください。
EXCEL VBA 連想配列でクロス集計・項目別集計・グループ集計 (Scripting.Dictionary) テクニック
● 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 | オブジェクト内の既存のキー値に対して新しいキー値を設定します。 |
【使用例】
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
' 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）については、同じ文字列での登録は可能です。
連想配列の登録・表示方法 （メッセージボックスに表示：Scripting.Dictionary)
下記のサンプルプログラムは、連想配列の登録方法と登録した連想配列データとメッセージボックスに表示する方法を説明いたします。
【プログラムの説明・処理手順】
① 1件目のデータ登録 “日本”, “Tokyo”
② ２件名のデータ登録 ”米国”, “Washington D.C”
③ ３件名のデータ登録 ”英国”, “London”
④ 登録されたデータをメッセージボックスに順番に表示します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
' '******** 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 ' |
（画面クリックして拡大）
連想配列を使って重複データを削除 (Scripting.Dictionary)
下記のサンプルプログラムは、A列の「勘定科目」が重複登録されています。このA列のデータを元に、B列に重複されていない勘定科目データを表示するサンプルプログラムです。
【プログラム説明・処理手順】
①A列のデータ（勘定科目）を全て読み取ります。
②A列のデータを1件ずつ確認して既に登録されていないかを確認
（新規の場合は、辞書登録（配列に登録）・既に登録されている場合は、何もしない）
③辞書登録（配列に登録）されている一覧データをB列に転記します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
' ' '******** 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 ’ |
（画面クリックして拡大）
重複データの削除（キー：Key、アイテム：Item）一意データの表示 (Scripting.Dictionary)
下記のサンプルプログラムは、上記のサンプル②と同じ重複データを削除するサンプルプログラムです。今回のサンプルプログラムは、キーとアイテムに部分にデータを登録を行い、キーデータ部分に対して重複データの削除を行います。
A列の「銀行コード」が重複登録されています。このA列のデータを元に、D列に重複データの無い「銀行コード」データ（キー）とアイテム部分「銀行名」をE列に表示させます。
【プログラム説明・処理手順】
①A列のデータ（キー）「銀行コード」とB列のデータ（アイテム）「銀行名」部分を全て読み取ります。
②A列のデータ（キー）「銀行コード」を1件ずつ確認して既に登録されていないかを確認
（新規の場合は、辞書登録（配列に登録（追加））・既に登録されている場合は、何もしない）
③辞書登録（配列に登録）されている一覧データをD列（キー）「銀行コード」・E列（アイテム）「銀行名」を転記します。
【連想配列の登録（追記）について】
※データを配列（連想配列）として登録する際は、A列のキー（銀行コード）とB列のアイテム（銀行名）を同時に登録（追加）します。
※キー部分は、重複登録不可
※アイテム部分は、重複登録可能
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
' '******** 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 ' |
（画面クリックして拡大）
連想配列を使用した集計（合計値）項目ごとの集計・重複データの削除 (Scripting.Dictionary)
下記のサンプルプログラムは、選択したデータを読み取り、重複データ（勘定科目）の削除を行い、勘定科目ごとに金額を集計するサンプルプログラムです。
【プログラム説明・処理手順】
①B列のデータ（キー）「勘定科目」を全て順番に読み取ります。
②B列のデータ（キー）「勘定科目」を1件ずつ確認して既に登録されていないかを確認します。
【新規登録の場合】
・新規の場合は、辞書登録（配列に登録・追加））F列に勘定科目とG列に金額をセルに記入します。
【既に登録されている場合】
・既に登録されている場合は、F列に登録されている勘定科目と同じ行に、金額を加算します。
③最後まで、データを順番に読み取り終わったら、F列・G列の1行目に項目名（勘定科目：合計金額）を付けます。
④F列・G列の最終行に合計値を記入して、集計された勘定科目範囲に、囲線を引きます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
' '******** 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 ' |
（画面クリックして拡大）
連想配列を使用した集計（合計値）項目ごとの集計・重複データの削除・結果を別シートに転記(Scripting.Dictionary)
下記のサンプルプログラムは、選択したデータを読み取り、重複データ（勘定科目）の削除を行い、勘定科目ごとに金額を集計するサンプルプログラムです。全体的な処理内容は、サンプル④と同じような作りですが、今回は、集計方法を「支店名＋勘定科目」の組み合わせで集計を行い、結果を別シートに作成します。
【プログラム説明・処理手順】
①ワークシート「データ一覧」・B列のデータ（キー）「支店名」＋「勘定科目」を全て順番に読み取ります。
②ワークシート「データ一覧」・B列のデータ（キー）「支店名」＋「勘定科目」を1件ずつ確認して既に登録されていないかを確認します。
【新規登録の場合】
・新規の場合は、辞書登録（配列に登録・追加））ワークシート「合計表」・F列に勘定科目とG列に金額をセルに記入します。
【既に登録されている場合】
・既に登録されている場合は、ワークシート「合計表」・F列に登録されている「支店名＋勘定科目」と同じ行に、金額を加算します。
③最後まで、データを順番に読み取り終わったら、F列・G列の1行目に項目名（支店名＋勘定科目：合計金額）を付けます。
④F列・G列の最終行に合計値を記入して、集計された勘定科目範囲に、囲線を引きます。
【プログラム実行条件】
ワークシート名・・・「データ一覧」には、A列「支店名」・B列「勘定科目」・C列「金額」
ワークシート名・・・「合計表」
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
' '******** 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 ' |
（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。