【Excel VBA】Dictionaryで項目ごとに件数・合計を集計する方法

みなさんこんにちは。

Excel VBAで売上データを扱っていると、同じ商品名や担当者名ごとに件数や合計金額をまとめたい場面があるかと思います。

このような集計にはDictionaryが便利です。商品名などをKeyにして、同じKeyが出てきたときだけ件数と金額を加算できます。

今回は、Dictionaryを使って商品名ごとの件数と合計金額を集計する方法をご紹介したいと思います。

この記事はこんな人におすすめ

VBAで項目ごとに集計したい人
DictionaryのExistsを使いたい人
件数と合計金額を一括で求めたい人

今回使用する元データ

A列に商品名、B列に金額が入力されているデータを例にします。同じ商品名が複数行に存在している状態です。

Dictionaryで件数・合計を集計する

Dictionaryでは商品名をKeyにし、値には「件数」と「合計金額」を配列で保存します。Existsで登録済みか確認し、重複している場合は値を加算します。

Sub SummaryByDictionary()

    Dim ws As Worksheet
    Dim dict As Object
    Dim lastRow As Long
    Dim i As Long
    Dim outputRow As Long
    Dim itemName As String
    Dim amount As Double
    Dim data As Variant
    Dim key As Variant

    '========================================
    ' 対象シートとDictionaryを準備する
    '========================================
    Set ws = Worksheets("Sheet1")
    Set dict = CreateObject("Scripting.Dictionary")

    'A列の最終行を取得する
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    '========================================
    ' 元データを1行ずつ集計する
    '========================================
    For i = 2 To lastRow

        itemName = Trim(CStr(ws.Cells(i, 1).Value))

        '商品名があり、金額が数値の場合だけ処理する
        If itemName <> "" And IsNumeric(ws.Cells(i, 2).Value) Then

            amount = CDbl(ws.Cells(i, 2).Value)

            If dict.Exists(itemName) Then
                '登録済みなら件数と金額を加算する
                data = dict(itemName)
                data(0) = data(0) + 1
                data(1) = data(1) + amount
                dict(itemName) = data
            Else
                '初回なら件数1で登録する
                dict.Add itemName, Array(1, amount)
            End If

        End If

    Next i

    '========================================
    ' 集計結果をD～F列へ出力する
    '========================================
    ws.Range("D1:F1").Value = Array("商品名", "件数", "合計金額")
    outputRow = 2

    For Each key In dict.Keys

        data = dict(key)

        ws.Cells(outputRow, 4).Value = key
        ws.Cells(outputRow, 5).Value = data(0)
        ws.Cells(outputRow, 6).Value = data(1)

        outputRow = outputRow + 1

    Next key

End Sub

実行すると、D列からF列へ商品名ごとの件数と合計金額が出力されます。