重複高速テンプレ
大量データで「重複チェック・削除・一覧化」をするとき、普通にセルを1つずつ見ていると遅くなります。そこで 配列＋Dictionary を使うと一気に高速化できます。初心者でも理解しやすいように、コード例をかみ砕いて説明します。
高速化の基本テクニック
- 画面更新停止:
Application.ScreenUpdating = False - イベント停止:
Application.EnableEvents = False - 計算停止:
Application.Calculation = xlCalculationManual
→ 終了時に必ず元に戻す。 - 配列に読み込む:
Range.Valueを配列に入れて一括処理。セルを1つずつ読むより数十倍速い。 - Dictionaryで突合: キー存在判定が一瞬でできる。重複判定に最適。
テンプレ1：重複を色でマーク（高速版）
A列の重複セルを黄色で塗ります。
Sub FastMarkDuplicates()
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
' 一旦色をクリア
ws.Range("A2:A" & lastRow).Interior.ColorIndex = xlNone
For i = 1 To UBound(v, 1)
Dim key As String: 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
- ポイント: 配列で一気に読み込むので速い。行番号はDictionaryに保持。
テンプレ2：重複一覧を別シートに出力（高速版）
A列の重複値と行番号を「重複一覧」シートに出力します。
Sub FastListDuplicates()
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 FastRemoveDuplicates()
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_Mark()
FastMarkDuplicates
End Sub
'例2：A列の重複一覧を高速に作成
Sub Example_List()
FastListDuplicates
End Sub
'例3：A列の重複行を高速に削除（2回目以降）
Sub Example_Remove()
FastRemoveDuplicates
End Sub
初心者向けポイント
- 配列＋Dictionary: セルを1つずつ読むより圧倒的に速い。
- 正規化:
Trim＋UCaseで表記揺れを吸収。 - 削除は下から: 行ズレ防止の鉄則。
- まずは一覧化: いきなり削除せず、候補を出して確認→承認→削除が安心。