大量データ専用重複テンプレ
数万行〜数十万行のデータを扱うとき、普通の「セルを1つずつ見る」方法では遅すぎます。そこで 配列＋Dictionary を使った「大量データ専用」の重複処理テンプレを紹介します。初心者でも理解できるように、コード例をかみ砕いて説明します。
大量データで速くするポイント
- 画面更新停止:
Application.ScreenUpdating = False - イベント停止:
Application.EnableEvents = False - 計算停止:
Application.Calculation = xlCalculationManual
→ 終了時に必ず元に戻す。 - 配列に読み込む:
Range.Valueで一括読み込み。セルを1つずつ読むより数十倍速い。 - Dictionaryで判定: キー存在判定が一瞬。重複チェックに最適。
テンプレ1：重複を色でマーク（大量データ対応）
A列の重複セルを黄色で塗ります。
Sub MarkDuplicates_BigData()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim ws As Worksheet: Set ws = Worksheets("Data")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim v As Variant: v = ws.Range("A2:A" & lastRow).Value
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long, key As String
ws.Range("A2:A" & lastRow).Interior.ColorIndex = xlNone
For i = 1 To UBound(v, 1)
key = UCase$(Trim$(CStr(v(i, 1))))
If Len(key) = 0 Then GoTo cont
If dict.Exists(key) Then
ws.Cells(i + 1, "A").Interior.Color = vbYellow
ws.Cells(dict(key), "A").Interior.Color = vbYellow
Else
dict(key) = i + 1
End If
cont:
Next
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "大量データでも高速に重複をマークしました"
End Sub
テンプレ2：重複一覧を別シートに出力（大量データ対応）
A列の重複値と行番号を「重複一覧」シートに出力します。
Sub ListDuplicates_BigData()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim ws As Worksheet: Set ws = Worksheets("Data")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim v As Variant: v = ws.Range("A2:A" & lastRow).Value
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim pos As Object: Set pos = CreateObject("Scripting.Dictionary")
Dim i As Long, key As String
For i = 1 To UBound(v, 1)
key = UCase$(Trim$(CStr(v(i, 1))))
If Len(key) = 0 Then GoTo cont
If dict.Exists(key) Then
pos(key) = pos(key) & "," & (i + 1)
Else
dict(key) = True
pos(key) = CStr(i + 1)
End If
cont:
Next
Dim out As Worksheet
On Error Resume Next
Set out = Worksheets("重複一覧")
On Error GoTo 0
If out Is Nothing Then
Set out = Worksheets.Add
out.Name = "重複一覧"
End If
out.Cells.Clear
out.Range("A1:C1").Value = Array("値", "出現回数", "行番号一覧")
Dim r As Long: r = 2
Dim k As Variant
For Each k In pos.Keys
Dim arr() As String: arr = Split(pos(k), ",")
If UBound(arr) >= 1 Then
out.Cells(r, 1).Value = k
out.Cells(r, 2).Value = UBound(arr) + 1
out.Cells(r, 3).Value = pos(k)
r = r + 1
End If
Next
out.Columns.AutoFit
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "大量データでも高速に重複一覧を作成しました"
End Sub
テンプレ3：重複行を削除（2回目以降を削除）
A列の重複行を削除します。必ず「下から」削除。
Sub RemoveDuplicates_BigData()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim ws As Worksheet: Set ws = Worksheets("Data")
Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim v As Variant: v = ws.Range("A2:A" & lastRow).Value
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim delRows As Collection: Set delRows = New Collection
Dim i As Long, key As String
For i = 1 To UBound(v, 1)
key = UCase$(Trim$(CStr(v(i, 1))))
If Len(key) = 0 Then GoTo cont
If dict.Exists(key) Then
delRows.Add i + 1
Else
dict(key) = True
End If
cont:
Next
Dim r As Long
For r = delRows.Count To 1 Step -1
ws.Rows(delRows(r)).Delete
Next
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "大量データでも高速に重複行を削除しました: " & delRows.Count & "行"
End Sub
例題で練習
'例1：A列の重複セルを高速に色付け
Sub Example_MarkBig()
MarkDuplicates_BigData
End Sub
'例2：A列の重複一覧を高速に作成
Sub Example_ListBig()
ListDuplicates_BigData
End Sub
'例3：A列の重複行を高速に削除（2回目以降）
Sub Example_RemoveBig()
RemoveDuplicates_BigData
End Sub
初心者向けポイント
- 配列＋Dictionary: 大量データでも一瞬で判定できる。
- 正規化:
Trim＋UCaseで表記揺れを吸収。 - 削除は下から: 行ズレ防止の鉄則。
- まずは一覧化: いきなり削除せず、候補を出して確認→承認→削除が安心。