記事ID: 063
タイトル: 【VBA】Dictionaryで重複チェック・集計を高速化する方法(コピペOK)
カテゴリ: 高速化・最適化
一次キーワード: VBA Dictionary 使い方 集計
想定読者: For文の二重ループで処理が遅くて困っている事務・管理職
検索意図: VBAのDictionaryで重複チェック・ユニークリスト・グループ別集計を高速に行いたい
読者の悩み(1文): For文の二重ループで重複チェックしているが、データが増えると処理が遅くて待ち時間がストレス
読了後にできること(1文): Dictionaryを使って重複チェック・ユニークリスト作成・グループ別集計を高速に行えるようになる
前提条件:
- Excel版: Excel 2016以降 / Microsoft 365
- OS: Windows 10/11
- 保存形式: .xlsm(マクロ有効ブック)
- 貼り付け場所: 標準モジュール
- 実行方法: マクロ実行(F5)またはボタン割り当て
更新日: 2026-03-11
Contents
この記事でわかること
VBAのDictionaryオブジェクトで重複チェック・集計を高速化する方法を、コピペで動くコード付きで解説します。
- 対象:For文の二重ループで処理が遅くて困っている人
- 所要時間:コピペ → 実行まで3分
どんな場面で使う?
- 大量データの重複チェック — 数千〜数万行の顧客リストや商品リストで、同じデータが二重登録されていないか高速に確認したい場合。For文の二重ループでは数分かかる処理が、Dictionaryなら数秒で終わる
- ユニークリスト(一意の値の一覧)の作成 — プルダウンリストの選択肢を動的に作りたいとき、部署一覧や商品カテゴリ一覧を重複なしで抽出できる
- 部署別・月別・カテゴリ別の集計 — ピボットテーブルを使わずにVBAだけでグループ別の合計・件数・平均を計算したい場合。SUMIFSの代わりにもなる
- 2つのリストの突合(照合) — 「こちらのリストにあって、あちらのリストにないデータ」を高速に抽出したいとき。Existsメソッドで一発判定できる
- CSV取り込み後のデータクレンジング — CSV読み込みで取り込んだデータに重複や不整合がないかチェックする前処理として活用できる
完成イメージ
実行前(重複チェック):
| A列:商品名 | B列:結果 |
|---|---|
| りんご | |
| みかん | |
| りんご | |
| ぶどう | |
| みかん |
実行後:
| A列:商品名 | B列:結果 |
|---|---|
| りんご | |
| みかん | |
| りんご | 重複 |
| ぶどう | |
| みかん | 重複 |
さらに実務版では、部署別の売上集計をDictionaryで高速に行い、結果を別シートに出力できます。
—
自分も大量データの重複チェックをFor文の二重ループで書いていて、1万行のデータで3分以上かかっていました。正直、待ち時間がストレスで、処理が終わるまでPCの前でぼーっとしているだけの時間がもったいなかったです。
Dictionaryに切り替えたら、同じ処理が3秒で終わりました。速すぎて最初はバグかと思って、何度も結果を確認しました。
同じようにFor文の二重ループで重複チェックしている人が、この記事でDictionaryの便利さに気づけたらうれしいです。もっと早く知りたかった、と思える内容になっているはずです。
Dictionaryを使わない重複削除の方法はVBAで重複データを削除する方法で解説しています。Dictionaryは「削除」ではなく「チェック」や「集計」に強いので、目的に応じて使い分けてください。
—
Dictionaryの基本:CreateObjectで作成する
Dictionaryは「キー」と「値」のペアを管理するオブジェクトです。キーの検索が高速なので、重複チェックや集計に向いています。
Sub Dictionary基本()
' --- Dictionaryを作成(参照設定不要) ---
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
' --- キーと値を追加 ---
dict.Add "りんご", 100
dict.Add "みかん", 80
' --- キーの存在をチェック ---
If dict.Exists("りんご") Then
MsgBox "りんごは登録済みです(値: " & dict("りんご") & ")"
End If
' --- 件数を確認 ---
MsgBox "登録件数: " & dict.Count & "件"
' --- 後片付け ---
Set dict = Nothing
End Sub
ポイント:
CreateObject("Scripting.Dictionary")で作成すれば参照設定が不要。どのPCでもそのまま動きます.Exists(key)でキーの存在を高速に判定できます(これが重複チェックの核心).Add key, valueでキーと値のペアを登録します.Countで登録されているキーの件数を取得できます
Dim dict As New Scripting.Dictionaryと書く方法もありますが、これは参照設定(Microsoft Scripting Runtime)が必要です。他人にマクロを渡す場合はCreateObject方式が安全です。
重複チェック:データにダブりがないか調べる
A列のデータに対して、2回目以降に出現した値をB列に「重複」と表示します。
Sub 重複チェック()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
Dim key As String
Dim uniqueCount As Long
For i = 2 To lastRow ' 2行目から(1行目は見出し)
key = CStr(Cells(i, 1).Value)
If key <> "" Then
If dict.Exists(key) Then
' 既に登録済み → 重複
Cells(i, 2).Value = "重複"
Else
' 初出 → 登録
dict.Add key, i ' 値には初出の行番号を入れておく
End If
End If
Next i
uniqueCount = dict.Count
Set dict = Nothing
MsgBox "重複チェック完了(" & uniqueCount & "種類のユニーク値)"
End Sub
ポイント:
CStr(Cells(i, 1).Value)でセル値を文字列に変換してからキーに使います。数値の100と文字列の"100"はDictionaryでは別キーになるので、CStrで統一するのがコツです- 初出のデータは
.Addで登録し、2回目以降は.Existsが True になるので「重複」と判定します - 空欄は
key <> ""でスキップしています
なぜDictionaryがFor文の二重ループより圧倒的に速いかというと、内部でハッシュテーブルというデータ構造を使っているためです。二重ループでは「データ数 x データ数」回の比較が必要ですが、Dictionaryの .Exists は内部でハッシュ値を計算して直接アクセスするので、データ数が増えても検索速度がほぼ変わりません。1万行のデータなら、二重ループの1億回の比較が、Dictionaryでは1万回のExistsチェックで済みます。
最終行の取得方法を使って lastRow を取得しています。データ範囲の終端を正確に取得する方法は記事032を参照してください。
ユニークリスト作成:重複を除いた一覧を作る
A列のデータから重複を除いた一覧をC列に出力します。
Sub ユニークリスト作成()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
Dim key As String
' --- A列のデータをDictionaryに登録(重複は自動的に無視) ---
For i = 2 To lastRow
key = CStr(Cells(i, 1).Value)
If key <> "" Then
If Not dict.Exists(key) Then
dict.Add key, ""
End If
End If
Next i
' --- ユニークリストをC列に出力 ---
Cells(1, 3).Value = "ユニークリスト"
Dim keys As Variant
keys = dict.Keys
Dim uniqueCount As Long
uniqueCount = dict.Count
For i = 0 To uniqueCount - 1
Cells(i + 2, 3).Value = keys(i)
Next i
Set dict = Nothing
MsgBox "ユニークリスト作成完了(" & uniqueCount & "件)"
End Sub
ポイント:
.KeysはDictionaryに登録されたすべてのキーを配列で返します- 配列のインデックスは 0始まり なので、
For i = 0 To dict.Count - 1でループします - ユニークリスト作成は、プルダウンリストの選択肢を動的に作りたい場面でも活用できます
このコードでは値を空文字列 "" にしていますが、値に「初出の行番号」を入れておくと、後から「この値が最初に登場した行はどこか」を追えるようになります。重複チェックのコードと同じ考え方で、目的に応じて値に持たせる情報を変えるのがDictionaryを使いこなすコツです。
グループ別集計:部署別・カテゴリ別に合計する
A列「部署」、B列「売上」のデータを、部署別に売上合計を集計します。
Sub グループ別集計()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
Dim key As String
Dim value As Double
' --- 部署別に売上を合計 ---
For i = 2 To lastRow
key = CStr(Cells(i, 1).Value)
value = Cells(i, 2).Value
If key <> "" And IsNumeric(Cells(i, 2).Value) Then
If dict.Exists(key) Then
dict(key) = dict(key) + value ' 既存キーの値に加算
Else
dict.Add key, value ' 新規キーとして登録
End If
End If
Next i
' --- 集計結果をD列・E列に出力 ---
Cells(1, 4).Value = "部署"
Cells(1, 5).Value = "売上合計"
Dim keys As Variant
Dim items As Variant
keys = dict.Keys
items = dict.Items
Dim groupCount As Long
groupCount = dict.Count
For i = 0 To groupCount - 1
Cells(i + 2, 4).Value = keys(i)
Cells(i + 2, 5).Value = items(i)
Next i
Set dict = Nothing
MsgBox "グループ別集計完了(" & groupCount & "グループ)"
End Sub
ポイント:
dict(key) = dict(key) + valueがグループ別集計の核心。既存のキーに値を加算していきます.Addは同じキーがあるとエラーになりますが、dict(key) = valueの書き方なら上書きされるのでエラーになりません.ItemsでDictionaryに登録されたすべての値を配列で取得し、.Keysと組み合わせて出力しますIsNumericで数値以外のセル(空欄やエラー値)をスキップしています
配列で処理を高速化する方法と組み合わせれば、セルの読み書きを配列で一括処理してさらに高速化できます。フィルタで絞り込んでからコピーする方法はオートフィルタの記事で解説していますが、集計まで一気にやりたい場合はDictionaryが便利です。
実務版:大量データの重複チェック+結果を別シートに出力
※ 実行前にブックを上書き保存しておくと安心です。
部署別の売上集計をDictionaryで高速に行い、結果を「集計結果」シートに出力する実務版コードです。自分はこのコードを使ってから、月次レポートの部署別集計が一瞬で終わるようになりました。もっと早く知りたかった、と本気で思っています。
Sub 部署別売上集計_実務版()
Dim wsData As Worksheet
Dim wsResult As Worksheet
Dim dict As Object
Dim dictCount As Object
Dim lastRow As Long
Dim i As Long
Dim key As String
Dim value As Double
Set wsData = ThisWorkbook.Sheets("データ")
Set dict = CreateObject("Scripting.Dictionary")
Set dictCount = CreateObject("Scripting.Dictionary")
' --- 「集計結果」シートがなければ作成 ---
On Error Resume Next
Set wsResult = ThisWorkbook.Sheets("集計結果")
On Error GoTo 0
If wsResult Is Nothing Then
Set wsResult = ThisWorkbook.Sheets.Add(After:=wsData)
wsResult.Name = "集計結果"
Else
wsResult.Cells.Clear ' 既存データをクリア
End If
' --- データシートから部署別売上を集計 ---
lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
key = CStr(wsData.Cells(i, 1).Value) ' A列: 部署
If key <> "" Then
' 件数カウント
If dictCount.Exists(key) Then
dictCount(key) = dictCount(key) + 1
Else
dictCount.Add key, 1
End If
' 売上合計
If IsNumeric(wsData.Cells(i, 4).Value) Then
value = wsData.Cells(i, 4).Value ' D列: 売上
If dict.Exists(key) Then
dict(key) = dict(key) + value ' 加算
Else
dict.Add key, value ' 新規登録
End If
End If
End If
Next i
' --- 集計結果を別シートに出力 ---
wsResult.Cells(1, 1).Value = "部署"
wsResult.Cells(1, 2).Value = "売上合計"
wsResult.Cells(1, 3).Value = "件数"
Dim keys As Variant
Dim items As Variant
keys = dict.Keys
items = dict.Items
Dim groupCount As Long
groupCount = dict.Count
For i = 0 To groupCount - 1
wsResult.Cells(i + 2, 1).Value = keys(i) ' 部署名
wsResult.Cells(i + 2, 2).Value = items(i) ' 売上合計
wsResult.Cells(i + 2, 2).NumberFormat = "#,##0" ' 桁区切り
wsResult.Cells(i + 2, 3).Value = dictCount(keys(i)) ' 件数
Next i
' --- 見出し行の書式設定 ---
With wsResult.Range("A1:C1")
.Font.Bold = True
.Interior.Color = RGB(217, 225, 242)
End With
wsResult.Columns("A:C").AutoFit
' --- 後片付け ---
Set dict = Nothing
Set dictCount = Nothing
' --- 結果シートに移動 ---
wsResult.Activate
MsgBox "部署別売上集計が完了しました(" & groupCount & "部署)"
End Sub
コードの処理フロー解説(実務版)
実務版は大きく4つのブロックで構成されています。
- 出力先シートの準備 —
On Error Resume Nextで「集計結果」シートの存在をチェックし、なければ新規作成、あればCells.Clearでクリアします。なぜこの方式にするかというと、初回実行時でも2回目以降でも同じコードで動くようにするためです。シートの存在チェックにOn Error Resume Nextを使うのはVBAの定番パターンで、エラー処理で止まらないマクロを作る方法でも詳しく解説しています。
- 2つのDictionaryで同時集計 —
dictで売上合計、dictCountで件数をそれぞれ管理しています。なぜ2つのDictionaryを使うかというと、1つのDictionaryでは「キーに対して1つの値」しか持てないため。売上合計と件数という2種類の情報を同時に集計するには、Dictionaryを2つ用意するのがシンプルな解決策です。
- 集計結果の出力 —
.Keysと.Itemsで配列を取得し、ループで1行ずつシートに書き込みます。NumberFormat = "#,##0"で桁区切りを設定しているのは、金額が見づらくならないようにするため。
- 見出し行の書式設定 —
Font.BoldとInterior.Colorで見出しを目立たせ、AutoFitで列幅を自動調整しています。見た目の仕上げを入れておくと、そのまま報告資料として使えるので便利です。
このコードのポイント:
- 「集計結果」シートがなければ自動作成、あればクリアして上書き
- 売上合計と件数を1回のループで同時に集計するので効率的
- 桁区切りの書式(
#,##0)を自動設定して見やすく - 見出し行に色付けして表らしい見た目に仕上げる
- 空欄・数値以外のセルはスキップするので安全
エラー処理の基本はエラー処理で止まらないマクロを作る方法を参照してください。
落とし穴
自分も最初にDictionaryを使ったとき、参照設定を忘れて「ユーザー定義型は定義されていません」というエラーが出ました。ネットで調べても「参照設定を追加してください」としか書いてなくて困りました。結局、CreateObject("Scripting.Dictionary") で書けば参照設定なしで動くと知って解決しましたが、最初からこの書き方を知っていれば悩まなかったのに、と思います。
| # | 症状 | 原因 | 対策 |
|---|---|---|---|
| 1 | 「ユーザー定義型は定義されていません」エラー | Dim dict As New Scripting.Dictionary のように参照設定が必要な書き方をしている |
CreateObject("Scripting.Dictionary") で書けば参照設定不要 |
| 2 | 同じ値なのに重複と判定されない | 数値の 100 と文字列の "100" はDictionaryでは別キーとして扱われる |
CStr(セル値) で文字列に統一してからキーに登録する |
| 3 | 「このキーは既に割り当てられています」エラー | .Exists で確認せずに .Add を呼んでいる |
.Exists でチェックしてから .Add するか、dict(key) = value で上書き方式を使う |
| 4 | 大文字と小文字が区別されてしまう(またはされない) | DictionaryのCompareModeの設定による。デフォルトは区別する(BinaryCompare) | 区別したくない場合は dict.CompareMode = vbTextCompare をキー追加前に設定する |
| 5 | 集計結果がおかしい(合計が合わない) | 空欄やエラー値のセルを加算しようとしている | If key <> "" And IsNumeric(セル値) Then で空欄・非数値をスキップする |
| 6 | Dictionaryの処理は速いのにマクロ全体が遅い | セルへの読み書きがボトルネックになっている | データを配列に一括読み込みしてからDictionaryに登録する。処理時間の特定には処理時間計測を使う |
FAQ
Q1. 参照設定方式とCreateObject方式、どちらがいい?
| 項目 | 参照設定方式 | CreateObject方式 |
|---|---|---|
| 書き方 | Dim dict As New Scripting.Dictionary |
Set dict = CreateObject("Scripting.Dictionary") |
| 入力補完 | あり(IntelliSense) | なし |
| 他PCでの動作 | 参照設定が必要 | そのまま動く |
| おすすめ場面 | 自分だけで使う開発中 | 配布用・共有ファイル |
この記事ではCreateObject方式で統一しています。他人にファイルを渡す可能性があるなら、CreateObject方式が安全です。
Q2. DictionaryとCollectionの違いは?
| 項目 | Dictionary | Collection |
|---|---|---|
| キー存在確認 | .Exists で簡単にできる |
エラー処理で代用するしかない |
| 値の上書き | dict(key) = value で可能 |
一度削除して再追加が必要 |
| 全キー取得 | .Keys で一括取得 |
できない |
| 参照設定 | 必要(またはCreateObject) | 不要(標準機能) |
重複チェックや集計にはDictionaryが圧倒的に便利です。
Q3. Dictionaryはどのくらいのデータ量まで使える?
数十万件でも問題なく動きます。100万行クラスの場合は、セルを1行ずつ読むのではなく配列に一括読み込みしてからDictionaryに登録すると、さらに高速になります。
' 配列に一括読み込みしてからDictionaryに登録する例
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim data As Variant
data = Range("A2:A" & lastRow).Value ' 配列に一括読み込み
Dim i As Long
For i = 1 To UBound(data, 1)
If CStr(data(i, 1)) <> "" Then
dict(CStr(data(i, 1))) = ""
End If
Next i
配列×Dictionaryの高速化テクニックは配列で処理を高速化する方法で詳しく解説しています。
Q4. Dictionaryの中身をクリアするには?
dict.RemoveAll ' 全キーを一括削除
特定のキーだけ削除するなら:
dict.Remove "りんご" ' 指定したキーだけ削除
Q5. 複数のキーを組み合わせて集計するには?
部署×月のように複数条件で集計したい場合は、キーを連結します。
key = CStr(Cells(i, 1).Value) & "_" & Format(Cells(i, 2).Value, "YYYY-MM")
' 例: "営業部_2026-01"
区切り文字(_)を入れるのがポイントです。入れないと「営業部」+「1月」と「営業」+「部1月」が同じキーになってしまいます。より高度な条件での抽出は複数条件でデータを抽出してまとめる方法を参照してください。
まとめ
この記事では、VBAのDictionaryオブジェクトで重複チェック・集計を高速化する方法を解説しました。
- 作成:
CreateObject("Scripting.Dictionary")で参照設定不要 - 重複チェック:
.Exists(key)でキーの存在を高速判定 - ユニークリスト:
.Keysで全キーを配列で取得 - グループ別集計:
dict(key) = dict(key) + valueでキー別に合計 - 実務版: 部署別売上集計を別シートに自動出力
Dictionaryは自分がVBAで学んで一番「もっと早く知りたかった」と思った機能です。For文の二重ループで書いていた重複チェックや集計処理が、Dictionaryに書き換えるだけで劇的に速くなる。しかもコードも短くなって読みやすくなります。まずは重複チェックの基本パターンから試してみて、慣れたらグループ別集計や複数キーの連結にも挑戦してみてください。Dictionaryのパターンを覚えると、データ処理系のマクロの大半はこれで書けるようになります。さらに速度を追求するなら、配列との組み合わせでセルの読み書きを一括化する方法を試す価値があります。
関連記事:
- 複数条件でデータを抽出してまとめる方法 — Dictionaryで集計した後のさらなる応用
- オートフィルタでデータを絞り込み・解除する方法 — フィルタとDictionaryの使い分け
- VBAで重複データを削除する方法 — Dictionaryを使わない重複削除のアプローチ
次にやりたくなること
- Dictionaryの処理をもっと高速化したい → 配列で処理を高速化する方法
- 集計したデータをさらに加工・抽出したい → 複数条件でデータを抽出してまとめる方法

コメント