Dictionaryで複数項目の
重複をまとめて集計する
A列とC列の組み合わせが同じ行を探し、F列の数値を合計したい。離れた場所に同じ項目が並ぶデータを、Dictionaryで一度に集計します。
今回やりたかったのは、重複している項目をまとめ、同じ項目に対応する数値の合計を出す処理です。
元データでは、集計の基準になる項目がA列とC列にあり、合計したい数値がF列に入っています。A列とC列の両方が同じ行を一つのグループとして扱い、集計結果を別シートのA列・C列・F列へ書き出します。
実際の項目名やシート名は使わず、この記事では一般的な名称とサンプルデータに置き換えています。
WHY DICTIONARY
順不同の重複データをどうまとめるか
同じ項目が連続して並んでいれば、一つ前の行と比較しながら集計する方法も考えられます。しかし今回は、同じ組み合わせが離れた行にランダムに入っていました。
そこで、すでに登場した項目と合計値をセットで覚えておけるDictionaryを使います。
元データを上から下まで確認する役割。
同じ項目が離れていても、一つの合計値にまとめる役割。
For～NextとDictionaryの二者択一ではなく、Forで読み、Dictionaryでまとめる。
COMPOSITE KEY
A列とC列を一つのキーにする
最初に見た解説では、検索する項目が一つだけでした。今回はA列とC列の二つが一致したときに同じ項目と判断したいため、二つの値を連結してDictionaryのキーにします。
key = CStr(.Cells(i, "A").Value) & vbTab & _
CStr(.Cells(i, "C").Value)vbTabは、A列とC列の値を区切るために挟んでいます。たとえば「部品A＋工程1」と「部品A＋工程2」は、別のキーとして保存されます。
BEFORE / AFTER
離れた行にある同じ組み合わせを集計する
次の例では、「部品A・工程1」と「部品B・工程2」が離れた行に重複があります。これを右表のように行の並び順に関係なく、それぞれのF列を合算させます。
| A列 | C列 | F列 |
|---|---|---|
| 部品A | 工程1 | 3 |
| 部品B | 工程2 | 2 |
| 部品A | 工程1 | 5 |
| 部品A | 工程2 | 4 |
| 部品B | 工程2 | 6 |
| A列 | B列(C列) | C列 (F列合計) |
|---|---|---|
| 部品A | 工程1 | 8 |
| 部品B | 工程2 | 8 |
| 部品A | 工程2 | 4 |
CORE LOGIC
同じキーがあれば加算、なければ登録
Dictionaryを使う中心部分は、次のExistsによる分岐です。CDbl関数は、数値や数値形式の文字列を小数を含む実数として扱いたい場合に使用します。
If dict.Exists(key) Then
dict(key) = dict(key) + CDbl(.Cells(i, "F").Value)
Else
dict.Add key, CDbl(.Cells(i, "F").Value)
End Ifdict.Exists(key)同じA列・C列の組み合わせが、すでに登録されているか確認する。
dict(key) + 数値登録済みなら、そのキーが持っている合計値へF列の数値を加える。
dict.Add初めて登場した組み合わせなら、キーとF列の数値を新しく登録する。
dict.Keys集計後、重複のないキーを一つずつ取り出して別シートへ出力する。
COMPLETE SAMPLE
処理全体のサンプル
参照設定が不要なCreateObjectを使った例です。1行目を見出し、2行目からデータが始まる想定にしています。
Option Explicit
Sub AggregateWithDictionary()
Dim wsSource As Worksheet
Dim wsOutput As Worksheet
Dim dict As Object
Dim lastRow As Long
Dim i As Long
Dim key As String
Dim outputRow As Long
Dim item As Variant
Dim parts As Variant
Set wsSource = ThisWorkbook.Worksheets("元データ")
Set wsOutput = ThisWorkbook.Worksheets("集計結果")
Set dict = CreateObject("Scripting.Dictionary")
'A列を基準に最終行を取得
lastRow = wsSource.Cells(wsSource.Rows.Count, "A") _
.End(xlUp).Row
With wsSource
For i = 2 To lastRow
'A列とC列が両方空白の行は集計しない
If Len(.Cells(i, "A").Value) > 0 Or _
Len(.Cells(i, "C").Value) > 0 Then
'F列が数値の行だけを集計
If IsNumeric(.Cells(i, "F").Value) Then
key = CStr(.Cells(i, "A").Value) & vbTab & _
CStr(.Cells(i, "C").Value)
If dict.Exists(key) Then
dict(key) = dict(key) + _
CDbl(.Cells(i, "F").Value)
Else
dict.Add key, _
CDbl(.Cells(i, "F").Value)
End If
End If
End If
Next i
End With
'以前の集計結果を消す（集計専用シートを想定）
wsOutput.Range("A2:C" & wsOutput.Rows.Count) _
.ClearContents
'Dictionaryの内容をA列・B列・C列へ書き出す
outputRow = 2
For Each item In dict.Keys
parts = Split(CStr(item), vbTab)
wsOutput.Cells(outputRow, "A").Value = parts(0)
wsOutput.Cells(outputRow, "B").Value = parts(1)
wsOutput.Cells(outputRow, "C").Value = dict(item)
outputRow = outputRow + 1
Next item
End Sub変数は多く見えますが、それぞれ「元シート」「出力先」「最終行」「キー」「出力行」など役割が異なります。名前を役割に合わせておくと、処理の流れを追いやすくなります。
CHECK POINTS
使う前に確認しておきたい点
- 最終行の基準には、途中で空白にならない列を選ぶ
- F列に文字が混ざる可能性がある場合は、
IsNumericで確認する vbTabを含むデータを扱う場合は、別の区切り方法を検討する- 英字の大文字・小文字を同じものとして扱うなら、追加前に
dict.CompareMode = vbTextCompareを設定する - Dictionaryから出力される順序に頼らず、必要なら出力後に並べ替える
サンプルでは集計専用シートを前提にA～C列を消去します。ほかのデータがある場合は、必要な列だけを消すように変更してください。
SUMMARY
Dictionaryは、順不同の重複集計をシンプルにする
最初にコードを見ると少しハードルが高く感じますが、中心になる考え方は「同じキーがあれば足す、なければ新しく登録する」だけです。
- For～Nextで元データを一行ずつ確認する
- A列とC列を連結し、複数項目を一つのキーとして扱う
- 同じキーのF列をDictionary内で加算する
- 最後に重複のない結果を別シートへ書き出す
実際に一度動かしてみると、複数条件の集計でも構造はそれほど複雑ではありません。重複データをまとめる処理が必要になったとき、ぜひ候補にしたい方法です。