大量データ処理をさらに効率化するには、配列処理に加えてApplication.ScreenUpdating / Calculation / EnableEvents の高速化設定を組み合わせ、さらに Dictionary / Collection を活用すると、重複排除・集計・検索が爆速になります。
基本の流れ
- 自動範囲検出 → 配列に読み込み
- 配列処理（ループ）で Dictionary / Collection に格納
- Dictionary で重複排除・集計
- 結果を一括書き戻し
- 高速化設定で処理を最適化
高速化設定の基本
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' …処理…
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Dictionary を使った応用例
例1：重複排除（ユニーク値抽出）
Sub UniqueValues()
Dim lastRow As Long, data As Variant
Dim dict As Object, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
data = Range(Cells(1, 1), Cells(lastRow, 1)).Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data, 1)
If Not dict.Exists(data(i, 1)) Then
dict.Add data(i, 1), 1
End If
Next i
' 結果を一括書き戻し
Range("C1").Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
例2：集計処理（値の出現回数カウント）
Sub CountValues()
Dim lastRow As Long, data As Variant
Dim dict As Object, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
data = Range(Cells(1, 1), Cells(lastRow, 1)).Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data, 1)
If dict.Exists(data(i, 1)) Then
dict(data(i, 1)) = dict(data(i, 1)) + 1
Else
dict.Add data(i, 1), 1
End If
Next i
' 結果出力
Range("C1").Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
Range("D1").Resize(dict.Count, 1).Value = Application.Transpose(dict.Items)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Collection を使った応用例
例3：順序付きユニーク値保持
Sub UniqueCollection()
Dim lastRow As Long, data As Variant
Dim col As New Collection, i As Long, v
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
data = Range(Cells(1, 1), Cells(lastRow, 1)).Value
On Error Resume Next
For i = 1 To UBound(data, 1)
col.Add data(i, 1), CStr(data(i, 1)) ' キー指定で重複回避
Next i
On Error GoTo 0
' 出力
i = 1
For Each v In col
Cells(i, 3).Value = v
i = i + 1
Next v
End Sub
応用シナリオ
- ユニーク値抽出 → Dictionary.Keys
- 出現回数集計 → Dictionary.Items
- 順序保持ユニーク → Collection
- 大量データ処理 → 配列＋一括書き戻し
- イベント・画面更新停止 → 高速化設定
実務での使い分けポイント
- Dictionary → 高速検索・重複排除・集計
- Collection → 順序保持・簡易ユニーク管理
- 配列 → 大量データ処理の必須
- 高速化設定 → 数万行でも一瞬で処理
💡 この「配列処理 × 高速化設定 × Dictionary / Collection」テクニックを押さえれば、ユニーク抽出・集計・検索を爆速で処理できます。
