前のページではディクショナリオブジェクトを使用した重複データの削除を取り上げました。そのサンプルを見てわかった方もいると思いますが、重複データ処理と言いつつもキー項目の出現回数をカウントしていたので、集計処理と見ることもできます。
前ページでは、出現回数のカウント値を重複の判定に使用するだけでしたが、このページでは”集計”を少し掘り下げ、集計項目が複数ある場合の説明をしていきたいと思います。
複数の集計処理
ここでは簡単な例として、入力データを集約し、データ毎に出現回数、合計値、平均値を求めることを考えます。平均値は合計値と出現回数により求められるため、実質集計するのはデータの出現回数と合計値の2つとなります。
集計対象データと集計結果のイメージ
集計項目毎にディクショナリオブジェクトを用意する
集計項目が複数ある場合の一番単純な対処方法は集計項目毎にディクショナリオブジェクトを生成することです。以下の例は、出現回数カウント用と金額合計値用に2つのディクショナリオブジェクトを使用して集計を行う方法です。
Sub sample_dc014_01()
Dim dco_Count As Object
Dim dco_Sum As Object
Dim wRow As Long
Dim wKey As String
Dim varKeys As Variant
Dim var As Variant
Dim i As Long
'エクセルの列
Const COL_I_ITEM = 1
Const COL_I_PRICE = 2
Const COL_O_ITEM = 4
Const COL_O_CNT = 5
Const COL_O_SUM = 6
Const COL_O_AVG = 7
'ディクショナリオブジェクトの生成
Set dco_Count = CreateObject("Scripting.Dictionary")
Set dco_Sum = CreateObject("Scripting.Dictionary")
wRow = 3 '入力データ開始行
Do Until Cells(wRow, COL_I_ITEM).Value = ""
wKey = Cells(wRow, COL_I_ITEM).Value
If dco_Count.Exists(wKey) Then
'カウントアップ
dco_Count.Item(wKey) = CLng(dco_Count.Item(wKey)) + 1
'金額加算
dco_Sum.Item(wKey) = CLng(dco_Sum.Item(wKey)) + _
CLng(Cells(wRow, COL_I_PRICE).Value)
Else
'未登録の場合は新規登録
dco_Count.Add wKey, 1
dco_Sum.Add wKey, Cells(wRow, COL_I_PRICE).Value
End If
wRow = wRow + 1
Loop
'キー項目の配列を取得
varKeys = dco_Count.Keys
wRow = 3 '出力データ開始行
'集計項目の表示
For Each var In varKeys
Cells(wRow, COL_O_ITEM).Value = var
Cells(wRow, COL_O_CNT).Value = dco_Count.Item(var)
Cells(wRow, COL_O_SUM).Value = dco_Sum.Item(var)
Cells(wRow, COL_O_AVG).Value = _
dco_Sum.Item(var) / dco_Count.Item(var)
wRow = wRow + 1
Next
'ディクショナリオブジェクトの破棄
Set dco_Count = Nothing
Set dco_Sum = Nothing
End Sub Setステートメント Do…Loop
For Each…Next
LBound、UBound関数
データ型変換関数
下図テスト用のワークシートになります。
上記サンプルマクロを実行すると、右側に集計結果が表示されます。
複数の集計項目を配列で保持する
この例では、ディクショナリオブジェクトを1つだけ使用し、ディクショナリオブジェクトの値に出現回数と合計値を配列として格納する方法になります。この方法は集計項目がいくら増えてもディクショナリオブジェクト1つで済むのが利点です。
Sub sample_dc014_02()
Dim dco As Object
Dim wRow As Long
Dim wKey As String
Dim varKeys As Variant
Dim var As Variant
Dim varValues As Variant
Dim i As Long
'エクセルの列
Const COL_I_ITEM = 1
Const COL_I_PRICE = 2
Const COL_O_ITEM = 4
Const COL_O_CNT = 5
Const COL_O_SUM = 6
Const COL_O_AVG = 7
'Value値配列のインデックス
Const IDX_CNT = 0
Const IDX_SUM = 1
'ディクショナリオブジェクトの生成
Set dco = CreateObject("Scripting.Dictionary")
wRow = 3 '入力データ開始行
Do Until Cells(wRow, COL_I_ITEM).Value = ""
wKey = Cells(wRow, COL_I_ITEM).Value
If dco.Exists(wKey) Then
'キーに対応する配列を取得
varValues = dco.Item(wKey)
'カウントアップ
varValues(IDX_CNT) = CLng(varValues(IDX_CNT)) + 1
'金額加算
varValues(IDX_SUM) = CLng(varValues(IDX_SUM)) + _
CLng(Cells(wRow, COL_I_PRICE).Value)
dco.Item(wKey) = varValues
Else
'未登録の場合は
'カウント初期値と金額を配列として新規登録
dco.Add wKey, Array(1, Cells(wRow, COL_I_PRICE).Value)
End If
wRow = wRow + 1
Loop
'キー項目の配列を取得
varKeys = dco.Keys
wRow = 3 '出力データ開始行
'集計項目の表示
For Each var In varKeys
varValues = dco.Item(var)
Cells(wRow, COL_O_ITEM).Value = var
Cells(wRow, COL_O_CNT).Value = varValues(IDX_CNT)
Cells(wRow, COL_O_SUM).Value = varValues(IDX_SUM)
Cells(wRow, COL_O_AVG).Value = _
varValues(IDX_SUM) / varValues(IDX_CNT)
wRow = wRow + 1
Next
'ディクショナリオブジェクトの破棄
Set dco = Nothing
End Sub Setステートメント Do…Loop
For Each…Next
Array関数
LBound、UBound関数
データ型変換関数
実行結果は sample_dc014_01 と同じになります。