【ExcelVBA・マクロ】Dictionaryオブジェクト完全ガイド【連想配列で重複削除・集計処理を高速化!実例20パターンで徹底解説】

Dictionaryオブジェクト完全ガイド ExcelVBA

この記事では以下の悩みを実例コード20パターンで解決します:

  • 配列で重複削除が遅くて困っている
  • グループ集計を高速化したい
  • VLOOKUPより速い検索方法を知りたい
  • Dictionaryの基本操作(Add・Remove・Exists)を習得したい
  • 配列とDictionaryの使い分けを理解したい
  • CreateObject vs 参照設定の違いを知りたい

Dictionaryオブジェクトとは?

Dictionary(ディクショナリー)は、キー(Key)と値(Item)のペアを管理する連想配列オブジェクトです。

辞書のイメージ

キー(Key)値(Item)
りんご150円
バナナ100円
みかん80円

キーを指定すれば即座に値を取得できる 「辞書」 のようなデータ構造です。

Dictionaryの特徴

✅ 高速検索: キーで即座に値を取得(O(1)の計算量)
✅ 重複排除: 同じキーは1つだけ保持
✅ 順序保持: 追加順にキーが保持される
✅ 動的サイズ: 要素数を事前に決める必要なし
✅ 柔軟な型: キー・値ともに任意の型を格納可能

配列との違い

項目配列Dictionary
インデックス数値(0,1,2…)任意のキー(“A001”, “東京”, 123等)
検索速度遅い(ループ必要)超高速(直接アクセス)
重複チェック手動で実装自動(同一キー不可)
サイズ変更ReDim必要自動拡張
用途順序重視検索・集計重視

配列 vs Dictionary 処理速度比較

検証コード: 10,000件から値を検索

配列で検索(ループ)

Sub ArraySearch()
    Dim arr(1 To 10000) As String
    Dim i As Long, target As String
    
    ' データ準備
    For i = 1 To 10000
        arr(i) = "商品" & i
    Next i
    
    Dim startTime As Double
    startTime = Timer
    
    ' 検索(1,000回)
    For i = 1 To 1000
        target = "商品5000"
        Dim j As Long
        For j = 1 To 10000
            If arr(j) = target Then Exit For
        Next j
    Next i
    
    Debug.Print "配列検索: " & Format(Timer - startTime, "0.000") & "秒"
    ' 結果: 約 2.5秒
End Sub

Dictionaryで検索

Sub DictionarySearch()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    ' データ準備
    For i = 1 To 10000
        dic.Add "商品" & i, i
    Next i
    
    Dim startTime As Double
    startTime = Timer
    
    ' 検索(1,000回)
    For i = 1 To 1000
        Dim exists As Boolean
        exists = dic.Exists("商品5000")
    Next i
    
    Debug.Print "Dictionary検索: " & Format(Timer - startTime, "0.000") & "秒"
    ' 結果: 約 0.01秒
    
    Set dic = Nothing
End Sub

速度比較結果

処理内容配列Dictionary速度差
10,000件から1,000回検索2.5秒0.01秒250倍高速
10,000件の重複削除3.8秒0.15秒25倍高速
グループ集計(1,000グループ)5.2秒0.22秒24倍高速

結論: 検索・重複削除・集計処理では Dictionary が圧倒的に高速!

CreateObject vs 参照設定の比較

Dictionaryを使う方法は2つあります。

① CreateObject(遅延バインディング)

Sub UseCreateObject()
    Dim dic As Object  ' Object型
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "Key1", "Value1"
    Debug.Print dic("Key1")
    
    Set dic = Nothing
End Sub

② 参照設定(早期バインディング)

参照設定の追加手順:

  1. VBE(Visual Basic Editor)を開く
  2. ツール → 参照設定
  3. Microsoft Scripting Runtime にチェック ✔
  4. OK をクリック
Sub UseReference()
    Dim dic As Scripting.Dictionary  ' 明示的な型
    Set dic = New Scripting.Dictionary
    
    dic.Add "Key1", "Value1"
    Debug.Print dic("Key1")
    
    Set dic = Nothing
End Sub

比較表

項目CreateObject参照設定
宣言Dim dic As ObjectDim dic As Scripting.Dictionary
生成Set dic = CreateObject("Scripting.Dictionary")Set dic = New Scripting.Dictionary
インテリセンス✗ なし✔ あり
処理速度やや遅い速い
配布参照設定不要参照設定が必要
環境依存低い高い
推奨度配布用・複数環境開発時

推奨

  • 開発時: 参照設定(インテリセンスが便利、高速)
  • 配布時: CreateObject(環境に依存しない)

本記事では CreateObject を使用します(配布しやすいため)。

CreateObjectについて詳しく知りたい方はこちらの記事をごらんください。

【ExcelVBA・マクロ】CreateObject完全ガイド【外部ライブラリ連携の基本から実務活用まで徹底解説】
この記事で解決できる悩み ✅ CreateObjectの使い方が分からない ✅ 参照設定との違いが分からない ✅ FileSystemObjectやDictionaryの使い方が知りたい ✅ エラー429「オブジェクトを作成できません」が出...
igapblog.com
2026.02.16

基本操作(Add・Remove・Exists・Keys・Items)

主なプロパティ・メソッド

名前種類説明
Addメソッドキーと値を追加
Removeメソッド指定キーの要素を削除
RemoveAllメソッド全要素を削除
Existsメソッドキーの存在確認
Keysプロパティ全キーを配列で取得
Itemsプロパティ全値を配列で取得
Countプロパティ要素数
Itemプロパティ値の取得・設定
Keyプロパティキーの変更
CompareModeプロパティ比較モード(0=バイナリ, 1=テキスト)

Add(追加)

Sub AddExample()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    ' キーと値を追加
    dic.Add "商品A", 1000
    dic.Add "商品B", 1500
    dic.Add "商品C", 800
    
    Debug.Print dic("商品A")  ' → 1000
    
    Set dic = Nothing
End Sub

重複キーエラー回避

Sub AddSafe()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim key As String, value As Long
    key = "商品A"
    value = 1000
    
    ' 既存キーチェック
    If Not dic.Exists(key) Then
        dic.Add key, value
        Debug.Print "追加成功"
    Else
        Debug.Print "既に存在します"
    End If
    
    Set dic = Nothing
End Sub

Item(値の取得・更新)

Sub ItemExample()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "商品A", 1000
    
    ' 値を取得
    Debug.Print dic.Item("商品A")  ' → 1000
    Debug.Print dic("商品A")       ' → 1000(省略形)
    
    ' 値を更新
    dic.Item("商品A") = 1200
    dic("商品A") = 1200  ' 省略形
    
    Debug.Print dic("商品A")  ' → 1200
    
    Set dic = Nothing
End Sub

注意: 存在しないキーを参照すると 自動的に追加される(値はEmpty)

dic.Add "A", 100
Debug.Print dic.Count  ' → 1

' 存在しないキーを参照
Debug.Print dic("B")   ' → Empty(空)
Debug.Print dic.Count  ' → 2(自動追加された!)

Exists(存在確認)

Sub ExistsExample()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "商品A", 1000
    
    If dic.Exists("商品A") Then
        Debug.Print "商品Aは存在します"
    End If
    
    If Not dic.Exists("商品B") Then
        Debug.Print "商品Bは存在しません"
    End If
    
    Set dic = Nothing
End Sub

Remove(削除)

Sub RemoveExample()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "商品A", 1000
    dic.Add "商品B", 1500
    dic.Add "商品C", 800
    
    Debug.Print dic.Count  ' → 3
    
    ' 特定キーを削除
    dic.Remove "商品B"
    Debug.Print dic.Count  ' → 2
    
    ' 全削除
    dic.RemoveAll
    Debug.Print dic.Count  ' → 0
    
    Set dic = Nothing
End Sub

Keys・Items(全要素取得)

Sub KeysItemsExample()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' 全キーを配列で取得
    Dim keys As Variant
    keys = dic.Keys
    
    Dim i As Long
    For i = LBound(keys) To UBound(keys)
        Debug.Print keys(i)  ' → りんご、バナナ、みかん
    Next i
    
    ' 全値を配列で取得
    Dim items As Variant
    items = dic.Items
    
    For i = LBound(items) To UBound(items)
        Debug.Print items(i)  ' → 150、100、80
    Next i
    
    Set dic = Nothing
End Sub

CompareMode(大文字小文字区別)

Sub CompareModeExample()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    ' 0 = vbBinaryCompare(大文字小文字を区別)
    dic.CompareMode = 0
    
    dic.Add "Apple", 100
    dic.Add "apple", 200  ' OK(別キーとして追加)
    
    Debug.Print dic.Count  ' → 2
    
    ' 1 = vbTextCompare(大文字小文字を区別しない)
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    
    dic.Add "Apple", 100
    dic.Add "apple", 200  ' エラー!(同じキーとみなされる)
    
    Set dic = Nothing
End Sub

注意: CompareMode は 最初の Add の前に設定 する必要があります。

ループ処理(For Each・For)

① For Each でキーをループ

Sub ForEachKeys()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' For Each でキーをループ
    Dim key As Variant
    For Each key In dic.Keys
        Debug.Print key & ": " & dic(key) & "円"
    Next key
    ' 出力:
    ' りんご: 150円
    ' バナナ: 100円
    ' みかん: 80円
    
    Set dic = Nothing
End Sub

重要: For Each key In dic ではなく For Each key In dic.Keys が推奨(明示的)。

② For Each で値をループ

Sub ForEachItems()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' For Each で値をループ
    Dim item As Variant
    For Each item In dic.Items
        Debug.Print item & "円"
    Next item
    
    Set dic = Nothing
End Sub

③ For ループ(インデックス指定)

Sub ForLoop()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' Keys・Itemsを配列化
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    ' Forループ
    Dim i As Long
    For i = 0 To dic.Count - 1
        Debug.Print keys(i) & ": " & items(i) & "円"
    Next i
    
    Set dic = Nothing
End Sub

④ キーと値を同時にループ(高速)

Sub FastLoop()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' 配列化(高速化)
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim i As Long
    For i = LBound(keys) To UBound(keys)
        Debug.Print keys(i) & ": " & items(i) & "円"
    Next i
    
    Set dic = Nothing
End Sub

速度比較: 大量データ(10,000件以上)では For ループ(配列化)が For Each より約2倍高速。

重複削除の実例5パターン

① 単純な重複削除

Sub RemoveDuplicates()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列のデータを読み込み(重複自動排除)
    Dim i As Long
    For i = 2 To lastRow  ' 2行目から(1行目は見出し)
        Dim value As String
        value = ws.Cells(i, 1).Value
        
        If Not dic.Exists(value) Then
            dic.Add value, ""
        End If
    Next i
    
    ' 重複なしデータを出力
    Dim keys As Variant
    keys = dic.Keys
    
    For i = 0 To UBound(keys)
        ws.Cells(i + 2, 2).Value = keys(i)  ' B列へ出力
    Next i
    
    MsgBox "重複削除完了: " & dic.Count & " 件"
    Set dic = Nothing
End Sub

② 重複回数をカウント

Sub CountDuplicates()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 出現回数をカウント
    Dim i As Long
    For i = 2 To lastRow
        Dim value As String
        value = ws.Cells(i, 1).Value
        
        If dic.Exists(value) Then
            dic(value) = dic(value) + 1  ' カウント増加
        Else
            dic.Add value, 1  ' 初回登場
        End If
    Next i
    
    ' 結果を出力
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    For i = 0 To UBound(keys)
        ws.Cells(i + 2, 2).Value = keys(i)      ' B列: 項目名
        ws.Cells(i + 2, 3).Value = items(i)     ' C列: 出現回数
    Next i
    
    MsgBox "カウント完了"
    Set dic = Nothing
End Sub

③ 複数列で重複チェック(複合キー)

Sub RemoveDuplicatesMultiColumn()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列+B列を結合してキーにする
    Dim i As Long
    For i = 2 To lastRow
        Dim key As String
        key = ws.Cells(i, 1).Value & "_" & ws.Cells(i, 2).Value
        
        If Not dic.Exists(key) Then
            dic.Add key, ""
        End If
    Next i
    
    MsgBox "ユニーク件数: " & dic.Count & " 件"
    Set dic = Nothing
End Sub

④ 初回出現行を保持

Sub KeepFirstOccurrence()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 初回出現行番号を保存
    Dim i As Long
    For i = 2 To lastRow
        Dim value As String
        value = ws.Cells(i, 1).Value
        
        If Not dic.Exists(value) Then
            dic.Add value, i  ' 行番号を保存
        End If
    Next i
    
    ' 初回出現行のみ残して他を削除
    For i = lastRow To 2 Step -1
        value = ws.Cells(i, 1).Value
        If dic(value) <> i Then
            ws.Rows(i).Delete  ' 重複行を削除
        End If
    Next i
    
    MsgBox "重複削除完了"
    Set dic = Nothing
End Sub

⑤ 重複行のみ抽出

Sub ExtractDuplicates()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 出現回数をカウント
    Dim i As Long
    For i = 2 To lastRow
        Dim value As String
        value = ws.Cells(i, 1).Value
        
        If dic.Exists(value) Then
            dic(value) = dic(value) + 1
        Else
            dic.Add value, 1
        End If
    Next i
    
    ' 2回以上出現した項目のみ出力
    Dim outRow As Long
    outRow = 2
    
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    For i = 0 To UBound(keys)
        If items(i) >= 2 Then
            ws.Cells(outRow, 2).Value = keys(i)      ' B列: 項目名
            ws.Cells(outRow, 3).Value = items(i)     ' C列: 重複回数
            outRow = outRow + 1
        End If
    Next i
    
    MsgBox "重複データ抽出完了"
    Set dic = Nothing
End Sub

グループ集計の実例5パターン

① 商品別売上合計

Sub SumByProduct()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 商品名、B列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim product As String
        Dim amount As Long
        product = ws.Cells(i, 1).Value
        amount = ws.Cells(i, 2).Value
        
        If dic.Exists(product) Then
            dic(product) = dic(product) + amount  ' 合計加算
        Else
            dic.Add product, amount  ' 初回登録
        End If
    Next i
    
    ' 結果を出力
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("集計結果")
    
    For i = 0 To UBound(keys)
        wsOut.Cells(i + 2, 1).Value = keys(i)      ' 商品名
        wsOut.Cells(i + 2, 2).Value = items(i)     ' 売上合計
    Next i
    
    MsgBox "集計完了"
    Set dic = Nothing
End Sub

② 店舗別売上集計

Sub SumByStore()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 店舗名、B列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim store As String
        Dim amount As Long
        store = ws.Cells(i, 1).Value
        amount = ws.Cells(i, 2).Value
        
        If dic.Exists(store) Then
            dic(store) = dic(store) + amount
        Else
            dic.Add store, amount
        End If
    Next i
    
    ' 結果を降順ソート出力(売上高い順)
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    ' バブルソート(降順)
    Dim j As Long, temp As Variant
    For i = 0 To UBound(items) - 1
        For j = i + 1 To UBound(items)
            If items(i) < items(j) Then
                ' 売上を交換
                temp = items(i)
                items(i) = items(j)
                items(j) = temp
                ' 店舗名も交換
                temp = keys(i)
                keys(i) = keys(j)
                keys(j) = temp
            End If
        Next j
    Next i
    
    ' 出力
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("集計結果")
    
    For i = 0 To UBound(keys)
        wsOut.Cells(i + 2, 1).Value = keys(i)
        wsOut.Cells(i + 2, 2).Value = items(i)
    Next i
    
    MsgBox "集計完了(売上高い順)"
    Set dic = Nothing
End Sub

③ 年月別集計

Sub SumByYearMonth()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 売上日、B列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim saleDate As Date
        Dim amount As Long
        saleDate = ws.Cells(i, 1).Value
        amount = ws.Cells(i, 2).Value
        
        ' YYYY-MM形式にフォーマット
        Dim yearMonth As String
        yearMonth = Format(saleDate, "yyyy-mm")
        
        If dic.Exists(yearMonth) Then
            dic(yearMonth) = dic(yearMonth) + amount
        Else
            dic.Add yearMonth, amount
        End If
    Next i
    
    ' 結果を出力
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("月次集計")
    
    For i = 0 To UBound(keys)
        wsOut.Cells(i + 2, 1).Value = keys(i)
        wsOut.Cells(i + 2, 2).Value = items(i)
    Next i
    
    MsgBox "月次集計完了"
    Set dic = Nothing
End Sub

④ 複数項目集計(件数・合計・平均)

Sub MultipleAggregation()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 商品名、B列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim product As String
        Dim amount As Long
        product = ws.Cells(i, 1).Value
        amount = ws.Cells(i, 2).Value
        
        If dic.Exists(product) Then
            ' 既存: 件数+1、合計加算
            Dim arr As Variant
            arr = dic(product)
            arr(0) = arr(0) + 1      ' 件数
            arr(1) = arr(1) + amount ' 合計
            dic(product) = arr
        Else
            ' 新規: 件数=1、合計=amount
            dic.Add product, Array(1, amount)
        End If
    Next i
    
    ' 結果を出力
    Dim keys As Variant
    keys = dic.Keys
    
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("集計結果")
    
    For i = 0 To UBound(keys)
        Dim stats As Variant
        stats = dic(keys(i))
        
        wsOut.Cells(i + 2, 1).Value = keys(i)             ' 商品名
        wsOut.Cells(i + 2, 2).Value = stats(0)            ' 件数
        wsOut.Cells(i + 2, 3).Value = stats(1)            ' 合計
        wsOut.Cells(i + 2, 4).Value = stats(1) / stats(0) ' 平均
    Next i
    
    MsgBox "集計完了(件数・合計・平均)"
    Set dic = Nothing
End Sub

⑤ クロス集計(店舗×商品)

Sub CrossTabulation()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 店舗、B列: 商品、C列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim store As String, product As String
        Dim amount As Long
        store = ws.Cells(i, 1).Value
        product = ws.Cells(i, 2).Value
        amount = ws.Cells(i, 3).Value
        
        ' 複合キー: "店舗_商品"
        Dim key As String
        key = store & "_" & product
        
        If dic.Exists(key) Then
            dic(key) = dic(key) + amount
        Else
            dic.Add key, amount
        End If
    Next i
    
    ' 結果を出力
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("クロス集計")
    
    For i = 0 To UBound(keys)
        ' "店舗_商品"を分割
        Dim parts As Variant
        parts = Split(keys(i), "_")
        
        wsOut.Cells(i + 2, 1).Value = parts(0)  ' 店舗
        wsOut.Cells(i + 2, 2).Value = parts(1)  ' 商品
        wsOut.Cells(i + 2, 3).Value = items(i)  ' 売上
    Next i
    
    MsgBox "クロス集計完了"
    Set dic = Nothing
End Sub

高速検索・高速マッチング

VLOOKUPより高速なマッチング

従来のVLOOKUP(遅い)

' 10,000件 × 1,000回検索 = 約15秒
For i = 2 To 1000
    value = Application.WorksheetFunction.VLookup(key, dataRange, 2, False)
Next i

Dictionaryで高速化

Sub FastLookup()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    ' マスタデータを辞書に格納
    Dim wsMaster As Worksheet
    Set wsMaster = ThisWorkbook.Worksheets("マスタ")
    
    Dim lastRow As Long
    lastRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row
    
    ' A列: キー、B列: 値
    Dim i As Long
    For i = 2 To lastRow
        dic.Add wsMaster.Cells(i, 1).Value, wsMaster.Cells(i, 2).Value
    Next i
    
    ' データシートで検索
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("データ")
    
    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
    
    ' A列のキーでB列に値を転記
    For i = 2 To lastRow
        Dim key As String
        key = wsData.Cells(i, 1).Value
        
        If dic.Exists(key) Then
            wsData.Cells(i, 2).Value = dic(key)
        Else
            wsData.Cells(i, 2).Value = "該当なし"
        End If
    Next i
    
    MsgBox "高速マッチング完了"
    Set dic = Nothing
End Sub
' 10,000件 × 1,000回検索 = 約0.5秒(30倍高速!)

複数条件検索

Sub MultiConditionLookup()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    ' マスタデータ読み込み
    Dim wsMaster As Worksheet
    Set wsMaster = ThisWorkbook.Worksheets("マスタ")
    
    Dim lastRow As Long
    lastRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 店舗、B列: 商品、C列: 単価
    Dim i As Long
    For i = 2 To lastRow
        Dim key As String
        key = wsMaster.Cells(i, 1).Value & "_" & wsMaster.Cells(i, 2).Value
        dic.Add key, wsMaster.Cells(i, 3).Value
    Next i
    
    ' データシートで検索
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("売上データ")
    
    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        Dim searchKey As String
        searchKey = wsData.Cells(i, 1).Value & "_" & wsData.Cells(i, 2).Value
        
        If dic.Exists(searchKey) Then
            wsData.Cells(i, 3).Value = dic(searchKey)  ' 単価を転記
        End If
    Next i
    
    MsgBox "複数条件検索完了"
    Set dic = Nothing
End Sub

複数キーを使った集計(複合キー)

店舗×商品×月の3次元集計

Sub ThreeDimensionAggregation()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 店舗、B列: 商品、C列: 売上日、D列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim store As String, product As String, yearMonth As String
        Dim amount As Long
        
        store = ws.Cells(i, 1).Value
        product = ws.Cells(i, 2).Value
        yearMonth = Format(ws.Cells(i, 3).Value, "yyyy-mm")
        amount = ws.Cells(i, 4).Value
        
        ' 3次元複合キー: "店舗_商品_年月"
        Dim key As String
        key = store & "_" & product & "_" & yearMonth
        
        If dic.Exists(key) Then
            dic(key) = dic(key) + amount
        Else
            dic.Add key, amount
        End If
    Next i
    
    ' 結果を出力
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("3次元集計")
    
    For i = 0 To UBound(keys)
        Dim parts As Variant
        parts = Split(keys(i), "_")
        
        wsOut.Cells(i + 2, 1).Value = parts(0)  ' 店舗
        wsOut.Cells(i + 2, 2).Value = parts(1)  ' 商品
        wsOut.Cells(i + 2, 3).Value = parts(2)  ' 年月
        wsOut.Cells(i + 2, 4).Value = items(i)  ' 売上
    Next i
    
    MsgBox "3次元集計完了"
    Set dic = Nothing
End Sub

Dictionary入れ子(ネスト)処理

店舗ごとに商品別売上を管理

Sub NestedDictionary()
    Dim dicStore As Object
    Set dicStore = CreateObject("Scripting.Dictionary")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("売上データ")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A列: 店舗、B列: 商品、C列: 売上金額
    Dim i As Long
    For i = 2 To lastRow
        Dim store As String, product As String
        Dim amount As Long
        
        store = ws.Cells(i, 1).Value
        product = ws.Cells(i, 2).Value
        amount = ws.Cells(i, 3).Value
        
        ' 店舗が未登録なら新規Dictionary作成
        If Not dicStore.Exists(store) Then
            Dim dicProduct As Object
            Set dicProduct = CreateObject("Scripting.Dictionary")
            dicStore.Add store, dicProduct
        End If
        
        ' 商品別売上を集計
        Set dicProduct = dicStore(store)
        
        If dicProduct.Exists(product) Then
            dicProduct(product) = dicProduct(product) + amount
        Else
            dicProduct.Add product, amount
        End If
    Next i
    
    ' 結果を出力
    Dim wsOut As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("集計結果")
    
    Dim outRow As Long
    outRow = 2
    
    ' 店舗ループ
    Dim storeKey As Variant
    For Each storeKey In dicStore.Keys
        Set dicProduct = dicStore(storeKey)
        
        ' 商品ループ
        Dim productKey As Variant
        For Each productKey In dicProduct.Keys
            wsOut.Cells(outRow, 1).Value = storeKey       ' 店舗
            wsOut.Cells(outRow, 2).Value = productKey     ' 商品
            wsOut.Cells(outRow, 3).Value = dicProduct(productKey)  ' 売上
            outRow = outRow + 1
        Next productKey
    Next storeKey
    
    MsgBox "入れ子集計完了"
    Set dicStore = Nothing
End Sub

実務テンプレート5選

① 汎用集計関数

Function GroupSum(ws As Worksheet, keyCol As Long, valCol As Long, startRow As Long) As Object
    ' 指定列でグループ集計してDictionaryを返す
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
    
    Dim i As Long
    For i = startRow To lastRow
        Dim key As String
        Dim value As Variant
        
        key = ws.Cells(i, keyCol).Value
        value = ws.Cells(i, valCol).Value
        
        If dic.Exists(key) Then
            dic(key) = dic(key) + value
        Else
            dic.Add key, value
        End If
    Next i
    
    Set GroupSum = dic
End Function

' 使用例
Sub UseGroupSum()
    Dim dic As Object
    Set dic = GroupSum(ThisWorkbook.Worksheets("売上データ"), 1, 2, 2)
    ' A列をキー、B列を値として2行目から集計
    
    MsgBox "集計完了: " & dic.Count & " 件"
    Set dic = Nothing
End Sub

② CSV出力

Sub ExportDictionaryToCSV()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    ' サンプルデータ
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' FSO でCSV出力
    Dim fso As Object, txt As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.CreateTextFile("C:\Export\dictionary_" & Format(Date, "yyyymmdd") & ".csv", True)
    
    ' ヘッダー
    txt.WriteLine "商品名,単価"
    
    ' データ
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim i As Long
    For i = 0 To UBound(keys)
        txt.WriteLine keys(i) & "," & items(i)
    Next i
    
    txt.Close
    Set txt = Nothing
    Set fso = Nothing
    Set dic = Nothing
    
    MsgBox "CSV出力完了"
End Sub

③ 2つのDictionaryをマージ

Sub MergeDictionaries()
    Dim dic1 As Object, dic2 As Object, dicMerged As Object
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    Set dicMerged = CreateObject("Scripting.Dictionary")
    
    ' Dictionary1
    dic1.Add "A", 100
    dic1.Add "B", 200
    
    ' Dictionary2
    dic2.Add "B", 50  ' 重複キー
    dic2.Add "C", 300
    
    ' マージ(値を合算)
    Dim key As Variant
    
    For Each key In dic1.Keys
        dicMerged.Add key, dic1(key)
    Next key
    
    For Each key In dic2.Keys
        If dicMerged.Exists(key) Then
            dicMerged(key) = dicMerged(key) + dic2(key)  ' 合算
        Else
            dicMerged.Add key, dic2(key)
        End If
    Next key
    
    ' 結果
    For Each key In dicMerged.Keys
        Debug.Print key & ": " & dicMerged(key)
    Next key
    ' A: 100
    ' B: 250 (200+50)
    ' C: 300
    
    Set dic1 = Nothing
    Set dic2 = Nothing
    Set dicMerged = Nothing
End Sub

④ Dictionary を配列に変換

Sub DictionaryToArray()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    dic.Add "りんご", 150
    dic.Add "バナナ", 100
    dic.Add "みかん", 80
    
    ' 2次元配列に変換
    Dim arr() As Variant
    ReDim arr(1 To dic.Count, 1 To 2)
    
    Dim keys As Variant, items As Variant
    keys = dic.Keys
    items = dic.Items
    
    Dim i As Long
    For i = 0 To UBound(keys)
        arr(i + 1, 1) = keys(i)
        arr(i + 1, 2) = items(i)
    Next i
    
    ' Excelシートへ一括出力
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    
    MsgBox "配列変換完了"
    Set dic = Nothing
End Sub

⑤ Dictionaryのディープコピー

Function DeepCopyDictionary(sourceDic As Object) As Object
    Dim newDic As Object
    Set newDic = CreateObject("Scripting.Dictionary")
    
    Dim key As Variant
    For Each key In sourceDic.Keys
        newDic.Add key, sourceDic(key)
    Next key
    
    Set DeepCopyDictionary = newDic
End Function

' 使用例
Sub UseDeepCopy()
    Dim dic1 As Object, dic2 As Object
    Set dic1 = CreateObject("Scripting.Dictionary")
    
    dic1.Add "A", 100
    dic1.Add "B", 200
    
    ' ディープコピー
    Set dic2 = DeepCopyDictionary(dic1)
    
    ' dic2を変更してもdic1は影響なし
    dic2("A") = 999
    
    Debug.Print dic1("A")  ' → 100(変更なし)
    Debug.Print dic2("A")  ' → 999(変更あり)
    
    Set dic1 = Nothing
    Set dic2 = Nothing
End Sub

よくある質問(FAQ 7問)

Q1. CreateObject と参照設定、どちらを使うべきですか?

A. 用途によって使い分けます。

  • 配布用・複数環境: CreateObject(環境依存しない)
  • 開発時: 参照設定(インテリセンスが便利、高速)

実務では CreateObject 推奨(配布が楽)。

Q2. 存在しないキーを参照するとどうなりますか?

A. 自動的に追加されます(値は Empty)。

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

dic.Add "A", 100
Debug.Print dic.Count  ' → 1

' 存在しないキーを参照
Debug.Print dic("B")   ' → Empty
Debug.Print dic.Count  ' → 2(自動追加された!)

対策: 必ず Exists でチェックしてからアクセス。

If dic.Exists("B") Then
    Debug.Print dic("B")
Else
    Debug.Print "存在しません"
End If

Q3. ループ中に要素を削除できますか?

A. For Each では不可(エラー発生)、For ループなら可能。

' ❌ For Each中の削除はNG
For Each key In dic.Keys
    If key = "削除対象" Then
        dic.Remove key  ' エラー!
    End If
Next key

' ✅ For ループで削除(逆順)
Dim keys As Variant
keys = dic.Keys

Dim i As Long
For i = UBound(keys) To LBound(keys) Step -1
    If keys(i) = "削除対象" Then
        dic.Remove keys(i)
    End If
Next i

Q4. Dictionaryをソートできますか?

A. Dictionary 自体にソート機能はありません。Keys・Items を配列化してソートします。

' 値でソート(降順)
Dim keys As Variant, items As Variant
keys = dic.Keys
items = dic.Items

' バブルソート
Dim i As Long, j As Long, temp As Variant
For i = 0 To UBound(items) - 1
    For j = i + 1 To UBound(items)
        If items(i) < items(j) Then
            ' 値を交換
            temp = items(i): items(i) = items(j): items(j) = temp
            ' キーも交換
            temp = keys(i): keys(i) = keys(j): keys(j) = temp
        End If
    Next j
Next i

Q5. Dictionaryに配列やオブジェクトを格納できますか?

A. 可能です。

' 配列を格納
dic.Add "Key1", Array(1, 2, 3, 4, 5)

' 取り出し
Dim arr As Variant
arr = dic("Key1")
Debug.Print arr(0)  ' → 1

' 別のDictionaryを格納
Dim dic1 As Object, dic2 As Object
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")

dic2.Add "SubKey", "SubValue"
dic1.Add "MainKey", dic2

' 取り出し
Debug.Print dic1("MainKey")("SubKey")  ' → SubValue

Q6. 大文字小文字を区別しないようにできますか?

A. CompareMode = 1 に設定します。

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

' 最初のAdd前に設定
dic.CompareMode = 1  ' vbTextCompare(大文字小文字を区別しない)

dic.Add "Apple", 100

Debug.Print dic.Exists("apple")  ' → True
Debug.Print dic.Exists("APPLE")  ' → True

注意: 最初の Add の前に設定する必要があります。

Q7. Dictionary のメモリ解放は必要ですか?

A. 明示的に Set dic = Nothing を推奨。

Sub ProperCleanup()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    ' ... 処理 ...
    
    ' クリーンアップ
    dic.RemoveAll  ' 全要素削除(オプション)
    Set dic = Nothing  ' メモリ解放
End Sub

プロシージャ終了時に自動解放されますが、大量データ処理では明示的に解放することでメモリを節約できます。

まとめと次のステップ

本記事のまとめ

✅ Dictionaryは配列より 検索が250倍高速
✅ 重複削除・グループ集計で 処理が25倍高速化
✅ Add・Remove・Exists・Keys・Items の基本操作を習得
✅ For Each・For ループの使い分けを理解
✅ 複合キー・入れ子 Dictionary で複雑な集計が可能
✅ CreateObject 推奨(環境非依存)
✅ CompareMode で大文字小文字制御

スポンサーリンク
スポンサーリンク
ExcelVBA
DictionaryExcelExcelVBAVBAエクセルプログラミングマクロ自動
シェアする
いがぴをフォローする
いがぴ

コメント

タイトルとURLをコピーしました