EXCEL VBA 連想配列で選択範囲を集計・別シートに取り出し・自由に選択した範囲を集計（テクニック）

EXCEL VBA 連想配列で選択範囲を集計・別シートに取り出し・自由に選択した範囲を集計（テクニック）

EXCEL VBA 連想配列を利用して選択範囲のデータを集計し同じシートへ集計結果を表示

'
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 連想配列を利用してアクティブセルで選択範囲を集計し、別シートに集計結果を表示（自由にデータ範囲を選択）

'
'
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 連想配列を利用して列を選択して集計項目選択を設定し、同じシートに集計結果を表示（自由に集計項目を選択）

'
'
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
'