dictionaryオブジェクトを連想配列的に使って、雑多なリストと数値にクロス集計をかけます。
Sheets("シート１").range("A1").value = "りんご"
Sheets("シート１").range("A2").value = "みかん"
Sheets("シート１").range("A3").value = "もも"
Sheets("シート１").range("A4").value = "すもも"
Sheets("シート１").range("A5").value = "みかん"
Sheets("シート１").range("A6").value = "りんご"
Sheets("シート１").range("B1").value = 100
Sheets("シート１").range("B2").value = 200
Sheets("シート１").range("B3").value = 150
Sheets("シート１").range("B4").value = 80
Sheets("シート１").range("B5").value = 20
Sheets("シート１").range("B6").value = 100
のデータがある時に、次の標準モジュールを定義し、”Sub hoge”を実行すると、
----------標準モジュールここから----------
Sub hoge()
Dim piyo As Object
Call Dictionary_X_sum(piyo, "シート１", 1, 1, 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("シート２").range("A1").value = "りんご"
Sheets("シート２").range("A2").value = "みかん"
Sheets("シート２").range("A3").value = "もも"
Sheets("シート２").range("A4").value = "すもも"
Sheets("シート２").range("B1").value = 200
Sheets("シート２").range("B2").value = 220
Sheets("シート２").range("B3").value = 150
Sheets("シート２").range("B4").value = 80
の出力が得られます。
まぁ同等の計算はマクロ使わずとも、ピボットテーブルで可能ですが、一連のマクロな処理の中でやりたい場合や、さらに加工とか、他のデータとの整合を取ったりする必要がある場合はこうやったほうが便利な時もあります。ちょっと弄れば合計値ではなく、件数とか平均の算出も当然可能です。