EXCEL VBA 連想配列で選択範囲を集計・別シートに取り出し・自由に選択した範囲を集計（テクニック）
EXCEL VBA 連想配列で選択範囲を集計・別シートに取り出し・自由に選択した範囲を集計（テクニック）
今回は、以前にも紹介しましたDictionary(連想配列)の使い方を説明いたします。連想配列を理解する事で、特にデータを集計する際には、とても重宝されるので、便利な利用方法をサンプルプログラムを交えて順番に説明いたします。なお、下記のリンク先にも連想配列に関する内容を記載しておりますので、参考にして下さい。
●【基礎的な連想配列は、下記を参照して下さい。】
●連想配列の応用：クロス集計表等は下記を参照してください。
EXCEL VBA 連想配列でクロス集計・項目別集計・グループ集計 (Scripting.Dictionary) テクニック
EXCEL VBA 連想配列を利用して選択範囲のデータを集計し同じシートへ集計結果を表示
下記のサンプルプログラムは、連想配列を利用して選択範囲のデータを集計して同じシートへ集計結果を表示するサンプルプログラムです。元のデータにある支店名と品目の組み合わせで集計表を作成します。正し、支店名と品目名の組み合わせで合計値が０円の場合は、集計結果に反映しません。
【集計条件】
・元データから支店名・品目の2種の組み合わせに該当する金額を集計します。
・支店名・品目の組み合わせで集計した結果、金額が０円の場合は、集計結果には、反映させない。
【プログラムの流れ】
① 新しいディクショナリーを登録します（支店名＆品目の組み合わせを対象）
② 集計結果を表示するG列からI列を削除します。
③ セル「A1」を基準に元となるデータを配列に登録します。
③ 配列データの最後まで繰り返します。（２行目から最終行まで繰り返します。）
④ 配列データに取り込んだ支店名・品目の組み合わせを作成します。
⑤ 支店名・品目名の組み合わせで未登録の組み合わせをディクショナリーへ登録します。
⑥ 既に支店名・品目の組み合わせが既にディクショナリーに登録されている場合は、同じ組み合わせに該当するディクショナリーへ金額を加算する。
⑦ 配列データの最後まで繰り返します。③へ
⑧ 配列登録したキーの配列変数を転記します。
⑨ 集計結果を表示するセル位置を指定します。2行目より
⑩ 集計した支店名・品目分の組み合わせ分のデータを繰り返します。
⑪ 集計した支店名・品目名の組み合わせの合計が０円以外を集計結果として表示対象とします。（集計結果が０円の場合は、表示させない）
⑫ 集計結果をG列：支店名・H列：品目・I列：合計を表示します。
⑬ 集計結果を表示位置を＋１行下へ加算します。データが無くなるまで⑪へ
⑭ 集計結果用のタイトルと背景色を表示します。
⑮ 集計結果に対して格子罫線を引きます。
|
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 |
' Sub Dictionary01() '連想配列を利用して選択範囲のデータを集計し同じシートへ集計結果を表示 Dim PC_Dict As Dictionary Dim PC_Salse, PcKeys, PcKey As Variant Dim I, L, Comma As Long Dim Shiten_name, Hani As String Set PC_Dict = New Dictionary '新しいディクショナリーの登録する。 Range("G:I").Clear 'G～I列の文字列・罫線等をクリアーする。 PC_Salse = Range("A1").CurrentRegion.Value 'セル「A1」からの表全体を配列に登録 For I = 2 To UBound(PC_Salse) '配列の最後まで繰り返す（2行目から最終行まで） Shiten_name = PC_Salse(I, 1) & "," & PC_Salse(I, 2) '支店名と品目を組み合わせます。 If Not PC_Dict.exists(Shiten_name) Then ' PC_Dict.Add Shiten_name, PC_Salse(I, 5) '支店名と品目の組み合わせて未登録の場合は、登録します。 Else PC_Dict(Shiten_name) = PC_Dict(Shiten_name) + PC_Salse(I, 5) '支店名と品目の組み合わせに該当する金額を加算する。 End If Next I PcKeys = PC_Dict.keys '配列登録したキーの配列変数を転記 L = 2 '表示するセル位置を2行目からスタート For Each PcKey In PcKeys 'すべての配列データを繰り返します。 Comma = InStr(PcKey, ",") If PC_Dict(PcKey) <> 0 Then '合計金額が０円以外を集計結果として表示対象とする。 Cells(L, "G") = Left(PcKey, Comma - 1) '支店名をG列に表示します。 Cells(L, "H") = Mid(PcKey, Comma + 1) '品目をH列に表示します。 Cells(L, "I") = PC_Dict(PcKey) '合計金額をI列に表示します。 Cells(L, "I").NumberFormatLocal = "#,###" L = L + 1 'セルの表示位置を下にずらします。＋１行 End If Next PcKey Range("G1") = "支店名": Range("H1") = "品目": Range("I1") = "合計" '集計結果タイトル作成 Range("G1:I1").Interior.ColorIndex = 35 Hani = Range("G1").CurrentRegion.Address(False, False) '指定セル(G1)から始まる表の範囲を取得 Range(Hani).Borders.LineStyle = xlContinuous '格子罫線を作成：細実線 End Sub ' |
（画面クリックして拡大）
EXCEL VBA 連想配列を利用してアクティブセルで選択範囲を集計し、別シートに集計結果を表示（自由にデータ範囲を選択）
下記のサンプルプログラムは、サンプルプログラム①の応用編となります。サンプル①では、集計元のデータについては、表範囲の全件が集計範囲になりましたが、今回のサンプル②では、データ範囲をアクティブセルで選択した行範囲でデータを集計して同じシートへ集計結果を表示するサンプルプログラムになります。集計条件は、サンプル①と同じ、支店名と品目の組み合わせで集計表を作成しますが、今回は、実行ボタンを作成「集計」し実行後、別シート「結果」に集計結果を表示するサンプルプログラムになります。
【集計条件】
・シート【データ】より、集計元となる範囲をアクティブセルで選択します。
・アクティブセルで選択した行範囲が集計元データとなり、この範囲から支店名・品目の2種の組み合わせと該当する金額を集計します。
・支店名・品目の組み合わせで集計した結果、金額が０円の場合は、集計結果には、反映させない。
【プログラムの流れ】
① 新しいディクショナリーを登録します（支店名＆品目の組み合わせを対象）
② ワークシートを設定します。（データ・結果）
③ 選択した範囲を取得（先頭行と最終行を取得します）※自由に選択した範囲の行番号を取得
④ 選択した範囲を配列へ登録する。
⑤ 登録した配列データの最後まで繰り返します。（先頭行から最終行まで繰り返します。）
⑥ 配列データに取り込んだ支店名・品目の組み合わせを作成します。
⑦ 支店名・品目名の組み合わせで未登録の組み合わせをディクショナリーへ登録します。
⑧ 既に支店名・品目の組み合わせが既にディクショナリーに登録されている場合は、同じ組み合わせに該当するディクショナリーへ金額を加算する。
⑨ 配列データの最後まで繰り返します。⑤へ
⑩ 配列登録したキーの配列変数を転記します。
⑪ 集計結果を表示するシート「集計」のセルA列～C列の文字列をクリアする。
⑫ 集計した支店名・品目分の組み合わせ分をデータに繰り返します。（シート「集計」へ転記）
⑬ 集計した支店名・品目名の組み合わせの合計が０円以外を集計結果として表示対象とします。（集計結果が０円の場合は、表示させない）
⑭ 集計結果を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 |
' ' Sub Dictionary02() 'アクティブセルで選択範囲を集計し、別シートに集計結果を表示 Dim ws01, ws02 As Worksheet Dim PC_Dict As Dictionary Dim PC_Salse, PcKeys, PcKey As Variant Dim I, L, Comma, stRow, enRow As Long Dim Shiten_name, Hani As String Set PC_Dict = New Dictionary '新しいディクショナリーを登録する Set ws01 = Worksheets("データ") 'ワークシートを設定 Set ws02 = Worksheets("結果") 'ワークシートを設定 stRow = Selection(1).Row '選択範囲の最上位の行番号を把握します。 enRow = Selection(Selection.Count).Row '選択範囲の最下位の行番号を把握します。 PC_Salse = ws01.Range("A" & stRow & ":E" & enRow) '選択範囲のセルデータを配列に登録します。 For I = 1 To UBound(PC_Salse) '登録した配列データ内の全データを繰り返します Shiten_name = PC_Salse(I, 1) & "," & PC_Salse(I, 2) '支店名と品目名を組み合わせます。 If Not PC_Dict.exists(Shiten_name) Then PC_Dict.Add Shiten_name, PC_Salse(I, 5) ' 支店名と品目の組み合わせて未登録の場合は、登録します。 Else PC_Dict(Shiten_name) = PC_Dict(Shiten_name) + PC_Salse(I, 5) '支店名と品目の組み合わせに該当する金額を加算する。 End If Next I PcKeys = PC_Dict.keys '配列登録したキーの配列変数を転記 L = 2 With ws02 '集計結果を表示するシート「集計」を選択します。 .Range("A:C").Clear 'A～C列の文字列をクリアーする。 For Each PcKey In PcKeys Comma = InStr(PcKey, ",") If PC_Dict(PcKey) <> 0 Then .Cells(L, "A") = Left(PcKey, Comma - 1) '支店 .Cells(L, "B") = Mid(PcKey, Comma + 1) '品目 .Cells(L, "C") = PC_Dict(PcKey) '金額 .Cells(L, "C").NumberFormatLocal = "#,###" '合計金額をI列に表示します。 L = L + 1 'セルの表示位置を下にずらします。＋１行 End If Next PcKey .Range("A1") = "支店名": .Range("B1") = "品目": .Range("C1") = "合計" '集計結果タイトル作成 .Range("A1:C1").Interior.ColorIndex = 35 Hani = .Range("A1").CurrentRegion.Address(False, False) '指定セル(A1)から始まる表の範囲を取得 .Range(Hani).Borders.LineStyle = xlContinuous '格子罫線を作成：細実線 .Activate End With End Sub ' |
※何度も行範囲を再選択して実行する事で、集計データを分析する時などで便利だと思います。
（画面クリックして拡大）
EXCEL VBA 連想配列を利用して列を選択して集計項目選択を設定し、同じシートに集計結果を表示（自由に集計項目を選択）
下記のサンプルプログラムは、上記のサンプルプログラムの応用になりますが、今回は、列（集計項目）を選択してデータを集計します。選択した項目ごとの組み合わせで集計する事が出来るので、情報を分析する際には、とても便利だと思います。選択する列（集計項目）は、複数列選択する事ができます。ただし、連続した列を選択した時のみ集計する事ができます。今回も「実行」ボタンを設置する事で、何度でも繰り返してプログラムを実行する事ができます。
①実行結果「年月」A列のみ選択して、月ごとにデータが集計されました。
②実行結果「年月・支店名」A列・B列を選択して、実行すると年月・支店名ごとにデータが集計されました。
③実行結果「品目・担当者」C列・D列を選択して、実行すると品目・担当者ごとにデータが集計されました。
【集計条件】
・シート【データ】より、集計する列（項目）を選択します。
・選択した列を元に、列データの組み合わせでデータを集計します。
※集計を選択する列は、連続した列を選択した場合のみ集計されます。
※【実行ボタン】の作成方法は、下記を参照して下さい。
|
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 |
' ' Sub Dictionary03() '選択した列項目に応じてデータを集計（連続した複数列のセル項目を選択可能） Dim PC_Dict As Dictionary Set PC_Dict = New Dictionary Dim PC_Koumoku, Hani As String Dim I, L, X, Y, STcol, ENcol, Comma As Long Dim PC_Salse, PCKeys, PCKey As Variant PC_Salse = Range("A1").CurrentRegion.Value 'A列から始まるデータを配列に登録します。 STcol = Selection(1).Column '選択しれ列の最小列を把握します。 ENcol = Selection(Selection.Count).Column '選択した最大列を把握します。 For I = 2 To UBound(PC_Salse) '配列に登録したデータ内の全てのデータを繰り返します。（2件目から最終まで） PC_Koumoku = "" '集計単位を登録する変数をクリアーします。 For X = STcol To ENcol '選択した列の最小列から最終列の間を繰り返します。 PC_Koumoku = PC_Koumoku & PC_Salse(I, X) & "," '集計単位の項目を作成します。 Next X If Not PC_Dict.exists(PC_Koumoku) Then PC_Dict.Add PC_Koumoku, PC_Salse(I, 5) '新たな集計単位が発生した場合は、集計項目と金額を登録します。 Else PC_Dict(PC_Koumoku) = PC_Dict(PC_Koumoku) + PC_Salse(I, 5) '既存の集計単位が有れば金額の集計します。 End If Next I I = 2 '集計結果を表示する転記先の行を指定します。 Range("H:L").Clear '結果を表示する列をH列～I列をクリアします。 PCKeys = PC_Dict.keys '配列登録したキーの配列変数を転記 For Each PCKey In PCKeys 'すべての配列データ（集計結果）を繰り返します。 PC_Salse = Split(PCKey, ",") 'カンマで区切られたデータ配列に転記します。 For L = 0 To UBound(PC_Salse) '集計項目データを全て繰り返します Cells(I, 8 + L) = PC_Salse(L) '集計項目・合計をセルに結果を転記します。 Cells(I, 8 + L).NumberFormatLocal = "#,###" '合計金額をカンマ表示します。 Next L Cells(I, L + 7) = PC_Dict(PCKey) '金額合計をセルに転記します。 I = I + 1 '転記先の列位置を＋１列にします。 Next PCKey '集計結果の1列目に見出しを作成します。 For I = STcol To ENcol Cells(1, I + 8 - STcol) = Cells(1, I) '選択した列に応じて列名（見出し）を転記します。 Cells(1, I + 8 - STcol).Interior.ColorIndex = 35 '見出しに背景色を設定します。 Next I Cells(1, I + 8 - STcol) = "合計" Cells(1, I + 8 - STcol).Interior.ColorIndex = 35 Hani = Range("H1").CurrentRegion.Address(False, False) '指定セル(H1)から始まる表の範囲を取得 Range(Hani).Borders.LineStyle = xlContinuous '格子罫線を作成：細実線 End Sub ' |
（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。