EXCEL VBA 連想配列でクロス集計・項目別集計・グループ集計 (Scripting.Dictionary)　テクニック

●はじめに

データを集計する際に、Dictionaryオブジェクトを利用してデータを集計すると、とても便利です。今回は、Dictionaryオブジェクトを利用して連想配列化して、クロス集計する方法を説明いたします。なお、連想配列は、簡単に言いますと数値以外のキーと要素がセットになった配列の事です。それでは、EXCEL　VBAでDictionaryオブジェクトを利用した連想配列化した、クロス集計の方法を説明いたします。

●【基礎的な連想配列は、下記を参照して下さい。】

●配列の使い方(Array LBound UBound)　基礎については、下記を参照してください。

●2次元配列・セル範囲の内容を配列に格納・配列の内容をセルに代入（一括・高速化・セルの指定範囲）については、下記を参照して下さい。

EXCEL VBA 連想配列でクロス集計・項目別集計①

●プログラム説明　（サンプル①）

下記のサンプルプログラムは、毎月発生する勘定科目毎の金額を年月と勘定科目毎に集計するサンプルプログラムです。Dictionaryオブジェクトを利用して連想配列化することで、簡単なプログラムでも、項目毎のクロス集計が可能になります。それでは、順番に内容を説明いたします。

【プログラム実行条件】
・ワークシート名を【売上明細】・【売上集計】に設定します。
・ワークシート名【売上明細】には、【A列：年月　B列：勘定科目　C列：金額】を入力します。
・ワークシート名【売上集計】のセルB2～以降（横）に年月を登録します。
・ワークシート名【売上集計】のセルA3～以降（下）に勘定科目を登録します。

'
'******** AKIRA55.COM ******* https://akira55.com//associative_array/
'

Sub Associative_Array01() '連想配列でクロス集計
    
    Dim ws01, ws02 As Worksheet
    Dim Dic As Object
    Dim keys As String
    Dim I, L, mRow As Long

    
    Set Dic = CreateObject("Scripting.Dictionary") ' 配列の定義
    
    Set ws01 = Worksheets("売上明細") ' 売上明細シート
    Set ws02 = Worksheets("売上集計") ' 売上集計シート
    
    mRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row   ' シート【売上明細】の最終行を取得します。
    
    
    With ws01 ' 売上明細を配列へ登録（集計）します。
        For L = 2 To mRow ' 最終行
            keys = .Cells(L, "A") & .Cells(L, "B") ' A列の年月とB列の勘定科目の組み合わせをキーとしてセットする。。
            Dic(keys) = Dic(keys) + .Cells(L, "C") ' 年月と勘定科目の組み合わせに一致する金額を加算する。（代入）
        Next
    End With
  
    
    With ws02  ' ワークシート【売上集計】へ集計結果を転記します。
   
        For I = 2 To 14 ' 集計表の列（横）
            For L = 3 To 14 ' 集計表の行（縦）
                keys = .Cells(2, I) & .Cells(L, 1) '年月と勘定科目をキーとしてセットします。
                .Cells(L, I) = Dic(keys) '該当するキーから値をセルに代入します。
            Next L
        Next I
    End With
    
    ws02.Select 'シート【集計】を表示する。
      
End Sub
'

●実行前～実行後　※プログラム実行後、シート「売上明細」に記載されている一覧データを元に、シート「売上集計」にクロス集計された売上集計表が作成されました。

EXCEL VBA 連想配列でクロス集計・項目別集計②（縦・横の項目を自動作成）

●プログラム説明　（サンプル②）

下記のサンプルプログラムは、上記サンプル①の応用編になります。上記サンプルプログラムでは、集計結果が表示されるシート【売上集計】に年月と勘定科目を記入する必要があります。事前にデータ内容を精査していれば可能ですが、大量のデータですと精査するのも大変なので、これもDictionaryオブジェクトを利用して一意データの年月と一意の勘定科目を抽出させます。この一意のデータを元に、データを集計します。

【プログラム実行条件】
・ワークシート名を【売上明細】・【売上集計】に設定します。
・ワークシート名【売上明細】には、【A列：年月　B列：勘定科目　C列：金額】を入力します。

'
'******** AKIRA55.COM ******* https://akira55.com//associative_array/
'

Sub Associative_Array02() '連想配列でクロス集計
    
    Dim ws01, ws02 As Worksheet
    Dim Dic01, Dic02, Dic03 As Object
    Dim key, hRow, hCol, Hani As String
    Dim I, L, mRow As Long
    Dim Item
    
    Set Dic01 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set Dic02 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set Dic03 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    
    
    Set ws01 = Worksheets("売上明細") ' 明細シート
    Set ws02 = Worksheets("売上集計") ' 集計シート
    
    mRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row   ' シート【売上明細】の最終行を求める
    
    
    With ws01 ' 売上明細を連想配列へ登録します。
    
        For L = 2 To mRow ' 最終行
            key = .Cells(L, "A") & .Cells(L, "B") ' A列の年月とB列の勘定科目の組み合わせをキーとしてセットする。。
            Dic01(key) = Dic01(key) + .Cells(L, "C") ' 年月と勘定科目の組み合わせに一致する金額を加算する。（代入）
             
             
             hCol = .Cells(L, "A")  '配列を使い年月の一意データを登録します。
             If Not Dic02.Exists(hCol) Then
                    Dic02.Add hCol, hCol
             End If
             
             hRow = .Cells(L, "B")  '配列を使い勘定科目の一意データを登録します。
             If Not Dic03.Exists(hRow) Then
                    Dic03.Add hRow, hRow
             End If
        Next L
    End With
        

    With ws02  ' ワークシート【集計売上】への表示します。
        .Cells.Clear 'ワークシート【売上集計】をクリアーします。
    
        Item = Dic03.keys
        For I = 0 To Dic03.Count - 1
            .Cells(3 + I, "A") = Item(I) 'シート【売上集計】のA列に勘定科目を一覧表示させます。
        Next I
        
        Item = Dic02.keys
        For I = 0 To Dic02.Count - 1
            .Cells(2, 2 + I) = Item(I)  'シート【売上集計】の2行名に年月を表示させます。
        Next I
        
        For I = 2 To Dic02.Count + 1  ' 列
            For L = 3 To Dic03.Count + 2  ' 行
                key = .Cells(2, I) & .Cells(L, 1) ' 年月と勘定科目と
                .Cells(L, I) = Dic01(key)
            Next
        Next
        
        Hani = .Range("B2").CurrentRegion.Address(False, False)  'セルB2から始まる表の範囲を取得
        
        .Range(Hani).Borders.LineStyle = xlContinuous  '格子罫線を作成：細実線（作成した表示表に線を引きます。）
        
    End With
End Sub
'

●実行前～実行後　※プログラム実行後、シート「売上明細」に記載されている一覧データを元に、シート「売上集計」にクロス集計された売上集計表が作成されました。

EXCEL VBA 連想配列でクロス集計・項目別集計③（複数項目を管理）

●プログラム説明　（サンプル③）

下記のサンプルプログラムは、今まで説明した上記サンプルプログラムの応用編になります。今回説明するプログラムは、集計するデータに複数項目が有る場合に、項目ごとに振り分けて集計するサンプルプログラムです。シート人件費データには、約1000件のデータを登録しています。このデータを横軸として、支店名・縦軸として、所属・役職・性別ごとに纏めるクロス集計表を作成します。

【プログラム動作　実行前⇒実行後】

【クロス集計の項目設定】

【プログラム実行条件】
・ワークシート名を【人事データ】・【売上集計】に設定します。
・ワークシート名【人事データ】には、【A列：社員番号　B列：支店名　C列：所属　D列：役職　E列：性別　F列：氏名　G列：人件費】を入力します。

'
'******** AKIRA55.COM ******* https://akira55.com//associative_array/
'

Sub Associative_Array04()   '連想配列でクロス集計
    
    Dim ws01, ws02 As Worksheet
    Dim Dic01, Dic02, Dic03 As Object
    Dim key, hRow, hCol, Hani As String
    Dim I, L, mRow As Long
    Dim Item
    
    Set Dic01 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set Dic02 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set Dic03 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    
    
    Set ws01 = Worksheets("人事データ") ' 明細シート
    Set ws02 = Worksheets("売上集計") ' 集計シート
    
    mRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row   ' シート【売上明細】の最終行を求める
    
    ws02.Cells.Clear 'ワークシート【売上集計】をクリアーします。
    
    With ws01 ' 売上明細を連想配列へ登録します。
    
        For L = 2 To mRow ' 最終行
            key = .Cells(L, "B") & .Cells(L, "C") & "_" & .Cells(L, "D") & "_" & .Cells(L, "E")
            Dic01(key) = Dic01(key) + .Cells(L, "G") ' 年月と勘定科目の組み合わせに一致する金額を加算する。（代入）
             
             
             hCol = .Cells(L, "B")  '配列を使い年月の一意データを登録します。
             If Not Dic02.Exists(hCol) Then
                    Dic02.Add hCol, hCol
             End If
             
             hRow = .Cells(L, "C") & "_" & .Cells(L, "D") & "_" & .Cells(L, "E")
             If Not Dic03.Exists(hRow) Then
                    Dic03.Add hRow, hRow
             End If
        Next L
    End With
        

    With ws02  ' ワークシート【集計シート】への表示します。
        ws02.Select 'シート【集計】を表示する。
        
        Item = Dic03.keys
        For I = 0 To Dic03.Count - 1
            .Cells(3 + I, "A") = Item(I) 'シート【売上集計】のA列に勘定科目を一覧表示させます。
        Next I
        
        Item = Dic02.keys
        For I = 0 To Dic02.Count - 1
            .Cells(2, 2 + I) = Item(I)  'シート【売上集計】の2行名に年月を表示させます。
        Next I
        
        For I = 2 To Dic02.Count + 1  ' 列
            For L = 3 To Dic03.Count + 2  ' 行
                key = .Cells(2, I) & .Cells(L, 1) ' 店舗CD & 分類CD
                .Cells(L, I) = Dic01(key)
            Next
        Next
        
        mRow = .Cells(Rows.Count, "A").End(xlUp).Row   ' シート【】の最終行を習得する。

        .Columns("B:D").EntireColumn.Insert 'D～Eの列に挿入（2列分）
        
        For I = 2 To mRow
            If InStr(Cells(I, 1), "_") > 0 Then  'A列に結合している【所属】・【役職】・【性別】を”＿”アンダーバー基準に区切り、別の列に代入します。
                .Cells(I, 2) = Split(Cells(I, 1), "_")(0)  'A列の結合している【所属】のみ代入します。（B列に代入：下記のA列を削除後、A列）
                .Cells(I, 3) = Split(Cells(I, 1), "_")(1)  'A列の結合している【役職】のみ代入します。（C列に代入：下記のA列を削除後、B列）
                .Cells(I, 4) = Split(Cells(I, 1), "_")(2)  'A列の結合している【性別】のみ代入します。（D列に代入：下記のA列を削除後、C列）
            End If
        Next I
    
      .Columns("A:A").EntireColumn.Delete 'A列を削除（A列全体を削除しますので、）
        
      .Range("A2") = "所属"
      .Range("B2") = "役職"
      .Range("C2") = "性別"
       Hani = .Range("A2").CurrentRegion.Address(False, False)  'セルA2から始まる表の範囲を取得
        
       .Range(Hani).Borders.LineStyle = xlContinuous  '格子罫線を作成：細実線（作成した表示表に線を引きます。）
    
    End With
    
End Sub
'

●実行前～実行後　※プログラム実行後、シート【人事データ】を元に、横軸に【支店名】・縦軸に「所属」・「役職」・「性別」別に該当する人件費が集計されて、クロス集計表が作成されました。

最後まで、ご覧いただきまして誠に有難うございました。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。

AKIRA