VBA Dictionary (SUMIFSのように集計)

２つの条件で集計する

セル直接版

Sub SumScoresByGroupAndName()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    
    Dim dictAll As Object    ' 班ごとのDictionary
    Dim dictGrp As Object    ' 班内の「名前→合計点」Dictionary
    Set dictAll = CreateObject("Scripting.Dictionary")
    dictAll.CompareMode = vbTextCompare   ' 班名の大小区別なし

    Dim lastRow As Long
    With ws
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("E:G").ClearContents
        .Range("E1").Value = "班"
        .Range("F1").Value = "名前"
        .Range("G1").Value = "合計点"
    End With
    
    Dim i As Long
    Dim groupKey As String, nameKey As String
    Dim score As Double

    ' --- ネストDictionaryを使った集計（SUMIFS相当） ---
    For i = 2 To lastRow
        groupKey = Trim(ws.Cells(i, 1).Value)   ' 班
        nameKey = Trim(ws.Cells(i, 2).Value)    ' 名前
        score = Val(ws.Cells(i, 3).Value)       ' 点数

        If Len(groupKey) > 0 And Len(nameKey) > 0 Then
            
            ' 班のDictionaryが無ければ作成
            If Not dictAll.Exists(groupKey) Then
                Set dictGrp = CreateObject("Scripting.Dictionary")
                dictGrp.CompareMode = vbTextCompare   ' 名前も大小区別なし
                dictAll.Add groupKey, dictGrp
            Else
                Set dictGrp = dictAll(groupKey)
            End If

            ' 班内の「名前ごとの合計」
            If dictGrp.Exists(nameKey) Then
                dictGrp(nameKey) = dictGrp(nameKey) + score
            Else
                dictGrp.Add nameKey, score
            End If
        End If
    Next i

    ' --- 結果を E列:班 / F列:名前 / G列:合計点 に出力 ---
    Dim gKey As Variant, nKey As Variant
    Dim outRow As Long: outRow = 2
    
    With ws
        For Each gKey In dictAll.Keys
            Set dictGrp = dictAll(gKey)
            
            For Each nKey In dictGrp.Keys
                .Cells(outRow, 5).Value = gKey
                .Cells(outRow, 6).Value = nKey
                .Cells(outRow, 7).Value = dictGrp(nKey)
                outRow = outRow + 1
            Next nKey
        Next gKey
    End With
    
    MsgBox "グループ×名前ごとの集計完了！", vbInformation

End Sub

→

配列＋ネストDictionary版

Sub SumScoresByGroupAndName_Array()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    
    Dim dictAll As Object, dictGrp As Object
    Set dictAll = CreateObject("Scripting.Dictionary")
    dictAll.CompareMode = vbTextCompare '班名 大小区別なし
    
    Dim lastRow As Long
    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        ' D:E(F:G)結果クリアと見出し
        .Range("E:G").ClearContents
        .Range("E1").Value = "班"
        .Range("F1").Value = "名前"
        .Range("G1").Value = "合計点"
        
        If lastRow < 2 Then
            MsgBox "データがありません。", vbExclamation
            Exit Sub
        End If
    End With

    ' ▼A2:C最終行を2次元配列で取得（1始まり）
    Dim data As Variant
    data = ws.Range("A2:C" & lastRow).Value

    Dim i As Long
    Dim groupKey As String, nameKey As String
    Dim score As Double

    ' --- 集計（SUMIFS相当） ---
    For i = 1 To UBound(data, 1)
        groupKey = Trim(data(i, 1))
        nameKey = Trim(data(i, 2))
        score = Val(data(i, 3))

        If Len(groupKey) > 0 And Len(nameKey) > 0 Then

            ' 班Dictionary取得（無ければ作る）
            If Not dictAll.Exists(groupKey) Then
                Set dictGrp = CreateObject("Scripting.Dictionary")
                dictGrp.CompareMode = vbTextCompare '名前の大小無視
                dictAll.Add groupKey, dictGrp
            Else
                Set dictGrp = dictAll(groupKey)
            End If

            ' 名前別集計
            If dictGrp.Exists(nameKey) Then
                dictGrp(nameKey) = dictGrp(nameKey) + score
            Else
                dictGrp.Add nameKey, score
            End If
        End If
    Next i

    ' --- 結果を配列にまとめて一括出力 ---
    Dim gKey As Variant, nKey As Variant
    Dim r As Long
    r = 1

    Dim result As Variant
    ReDim result(1 To dictAll.Count * 10, 1 To 3) '※最大見積（後で詰める）

    For Each gKey In dictAll.Keys
        Set dictGrp = dictAll(gKey)
        For Each nKey In dictGrp.Keys
            result(r, 1) = gKey
            result(r, 2) = nKey
            result(r, 3) = dictGrp(nKey)
            r = r + 1
        Next nKey
    Next gKey

    ' 実データ行数にフィットさせて出力
    ws.Range("E2").Resize(r - 1, 3).Value = result

    MsgBox "班×名前の合計点集計が完了しました！", vbInformation

End Sub

※ 結果は上記と同じ

SUMIFS vs Dictionary集計（高速版）

観点SUMIFSDictionary＋配列（高速版）
処理速度遅い（毎回全行検索）高速（1回走査で完了）
重複整理別処理必要（UNIQUE等）自動でマージ（1行/1キー管理）
出力形式単一セル結果一覧表が自動生成
データ規模耐性数万行で遅延数十万行でも対応可
前処理（空白・整形）関数に依存TrimやValで制御可能
大文字小文字区別なしCompareModeで選べる
拡張性単純な合計処理複数条件対応（SUMIFS相当）
メンテ性式の維持が必要VBAでロジック管理
学習難易度とても簡単少し高い（構造理解が必要）
  • Excelだけで済むならSUMIFS
  • 大量データ／一覧化／高速化が必要ならDictionary＋配列が最適解！

Dictionary版が強い理由（技術的）

  • 1回の配列走査で集計完了
  • ハッシュ検索で重複判定が高速
  • 配列→Rangeへ一括書き戻しでシート操作を最小化
  • キー管理によりデータ構造が整理される

コメント