MS-Excel‎ > ‎VBA編‎ > ‎

dictionaryオブジェクトでクロス集計

dictionaryオブジェクトを連想配列的に使って、雑多なリストと数値にクロス集計をかけます。

Sheets("シート1").range("A1").value = "りんご"
Sheets("シート1").range("A2").value = "みかん"
Sheets("シート1").range("A3").value = "もも"
Sheets("シート1").range("A4").value = "すもも"
Sheets("シート1").range("A5").value = "みかん"
Sheets("シート1").range("A6").value = "りんご"

Sheets("シート1").range("B1").value = 100
Sheets("シート1").range("B2").value = 200
Sheets("シート1").range("B3").value = 150
Sheets("シート1").range("B4").value = 80
Sheets("シート1").range("B5").value = 20
Sheets("シート1").range("B6").value = 100

のデータがある時に、次の標準モジュールを定義し、”Sub hoge”を実行すると、

----------標準モジュールここから----------
Sub hoge()
Dim piyo As Object
Call Dictionary_X_sum(piyo, "シート1", 1, 1, 2, "シート2", 1, 1, 2)
End Sub


Sub Dictionary_X_sum(ByRef my_key_X_sum_list As Object, _
ByVal read_sheet_name As String, _
ByVal read_table_row As Long, ByVal read_key_column_no As Long, ByVal read_sum_column_no As Long, _
ByVal out_sheet_name As String, _
ByVal out_table_row As Long, ByVal out_key_column_no As Long, ByVal out_sum_column_no As Long)

'
'ディクショナリオブジェクト用変数
Dim my_key As String
Set my_key_X_sum_list = CreateObject("Scripting.Dictionary")

'ループカウンタ変数
Dim j, k, l As Long
'For Each用変数
Dim x As Variant

'~~~~~処理本体~~~~~

'Dictionaryオブジェクトの連想配列の添字をread_key_column_no列の値としてread_sum_column_noの値を格納
j = read_table_row
With Sheets(read_sheet_name)
    While .Cells(j, read_key_column_no).Value <> ""

            my_key = .Cells(j, read_key_column_no).Value
            If my_key_X_sum_list.Exists(my_key) Then
                'read_key_column_no列の値でインデックスが作成済みの場合
                my_key_X_sum_list.Item(my_key) = my_key_X_sum_list.Item(my_key) + .Cells(j, read_sum_column_no).Value
            Else
                'read_key_column_no列の値でインデックスが未作成の場合
                my_key_X_sum_list.Add my_key, 0
                my_key_X_sum_list.Item(my_key) = .Cells(j, read_sum_column_no).Value
            End If
        
        j = j + 1
    Wend
End With

’■■■■■出力する前に、参照渡しで受け取ったmy_key_X_sum_listに手を加えたい場合はここからコメントアウト■■■■■
'このブロックをこのまま生かす時は本来は、ByRef my_key_X_sum_list As Objectの引数は必要なしです。
'またこのブロックをコメントアウトする場合は、out_sheet_name, out_table_row, out_key_column_no, out_sum_column_no
’の引数が必要ありません。(変更が面倒なので残しているだけ。)
'出力シートへの書き出し
j = out_table_row
With Sheets(out_sheet_name)
    For Each x In my_key_X_sum_list
        .Cells(j, out_key_column_no) = x
        .Cells(j, out_sum_column_no) = my_key_X_sum_list.Item(x)
        j = j + 1
    Next

End With
’■■■■■出力する前に、参照渡しで受け取ったmy_key_X_sum_listに手を加えたい場合はここまでコメントアウト■■■■■
End Sub
----------標準モジュールここまで----------

Sheets("シート2").range("A1").value = "りんご"
Sheets("シート2").range("A2").value = "みかん"
Sheets("シート2").range("A3").value = "もも"
Sheets("シート2").range("A4").value = "すもも"
Sheets("シート2").range("B1").value = 200
Sheets("シート2").range("B2").value = 220
Sheets("シート2").range("B3").value = 150
Sheets("シート2").range("B4").value = 80
の出力が得られます。

まぁ同等の計算はマクロ使わずとも、ピボットテーブルで可能ですが、一連のマクロな処理の中でやりたい場合や、さらに加工とか、他のデータとの整合を取ったりする必要がある場合はこうやったほうが便利な時もあります。ちょっと弄れば合計値ではなく、件数とか平均の算出も当然可能です。