Excel VBA 逆引き集 | 削除だけ削除

Excel VBA
スポンサーリンク

削除だけ削除

「前月Aにあって今月Bにない行＝削除対象」を見つけて、Aから削除するテンプレです。初心者でも壊れないように、キー突合・配列＋辞書・安全な削除の流れをかみ砕いて説明します。

削除の考え方

  • 対象: AにあるキーがBに存在しない行。
  • 処理: Aの該当行を削除（行ごと）。
  • 安全策: 下から削除する（上から削除すると行番号がずれて事故る）。

共通ユーティリティ（速度・安全）

Option Explicit

Private Sub SpeedOn()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Private Sub SpeedOff()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Function NormKey(ByVal v As Variant) As String
    NormKey = UCase$(Trim$(CStr(v)))
End Function
VB
  • SpeedOn/Off: 無駄な再描画・再計算を止めて高速安定。
  • NormKey: Trim＋UCaseで表記揺れを吸収。

基本テンプレ：Aから削除だけ削除（キー＝コード）

「A: コード/名称/単価」「B: コード/名称/単価」を突合し、Aにしかない行を削除します。

Sub DeleteOnlyDeletedRows()
    SpeedOn

    Dim wsA As Worksheet: Set wsA = Worksheets("A")
    Dim wsB As Worksheet: Set wsB = Worksheets("B")
    Dim rgA As Range: Set rgA = wsA.Range("A1").CurrentRegion
    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion
    Dim vA As Variant: vA = rgA.Value
    Dim vB As Variant: vB = rgB.Value

    'Bのキー集合
    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vB, 1)
        k = NormKey(vB(i, 1)) 'コード列
        If Len(k) > 0 Then setB(k) = True
    Next

    '削除対象行をリストアップ
    Dim delRows As Collection: Set delRows = New Collection
    For i = 2 To UBound(vA, 1)
        k = NormKey(vA(i, 1))
        If Len(k) > 0 And Not setB.Exists(k) Then
            delRows.Add rgA.Row + i - 1
        End If
    Next

    '下から削除
    Dim r As Long
    For r = delRows.Count To 1 Step -1
        wsA.Rows(delRows(r)).Delete
    Next

    SpeedOff
    MsgBox "削除件数: " & delRows.Count
End Sub
VB
  • ポイント
    • 辞書で存在判定: Bにないキーを削除対象に。
    • 下から削除: 行番号ずれを防ぐ。
    • 件数をMsgBox: 結果が分かりやすい。

見出し名で列特定（列順変更に強い）

列順が変わっても壊れないように、見出し名からキー列を取得します。

Private Function FindHeader(ByVal headerRow As Range, ByVal name As String) As Long
    Dim hit As Range
    Set hit = headerRow.Find(What:=name, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    FindHeader = IIf(hit Is Nothing, 0, hit.Column)
End Function

Sub DeleteOnlyDeletedRows_ByHeader()
    SpeedOn

    Dim wsA As Worksheet: Set wsA = Worksheets("A")
    Dim wsB As Worksheet: Set wsB = Worksheets("B")
    Dim rgA As Range: Set rgA = wsA.Range("A1").CurrentRegion
    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion
    Dim vA As Variant: vA = rgA.Value
    Dim vB As Variant: vB = rgB.Value

    Dim cKeyA As Long: cKeyA = FindHeader(rgA.Rows(1), "コード")
    Dim cKeyB As Long: cKeyB = FindHeader(rgB.Rows(1), "コード")
    If cKeyA = 0 Or cKeyB = 0 Then SpeedOff: MsgBox "キー見出し不足": Exit Sub

    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim i As Long, k As String
    For i = 2 To UBound(vB, 1)
        k = NormKey(vB(i, cKeyB))
        If Len(k) > 0 Then setB(k) = True
    Next

    Dim delRows As Collection: Set delRows = New Collection
    For i = 2 To UBound(vA, 1)
        k = NormKey(vA(i, cKeyA))
        If Len(k) > 0 And Not setB.Exists(k) Then
            delRows.Add rgA.Row + i - 1
        End If
    Next

    Dim r As Long
    For r = delRows.Count To 1 Step -1
        wsA.Rows(delRows(r)).Delete
    Next

    SpeedOff
    MsgBox "削除件数: " & delRows.Count
End Sub
VB
  • ポイント
    • 見出し名で列を特定するので列順変更に強い。
    • 見出し不足なら早期停止。

複合キー（コード×年月）で削除だけ削除

年月単位で存在しない行を削除したい場合。

Private Function BuildKey2(ByVal code As Variant, ByVal ymd As Variant) As String
    Dim ym As String
    If IsDate(ymd) Then ym = Format$(CDate(ymd), "yyyy-mm") Else ym = CStr(ymd)
    BuildKey2 = NormKey(code) & "|" & UCase$(Trim$(ym))
End Function

Sub DeleteOnlyDeletedRows_MultiKey()
    SpeedOn

    Dim wsA As Worksheet: Set wsA = Worksheets("A")
    Dim wsB As Worksheet: Set wsB = Worksheets("B")
    Dim rgA As Range: Set rgA = wsA.Range("A1").CurrentRegion
    Dim rgB As Range: Set rgB = wsB.Range("A1").CurrentRegion
    Dim vA As Variant: vA = rgA.Value
    Dim vB As Variant: vB = rgB.Value

    'B複合キー集合
    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim i As Long
    For i = 2 To UBound(vB, 1)
        setB(BuildKey2(vB(i, 1), vB(i, 2))) = True
    Next

    '削除対象
    Dim delRows As Collection: Set delRows = New Collection
    For i = 2 To UBound(vA, 1)
        Dim key As String: key = BuildKey2(vA(i, 1), vA(i, 2))
        If Not setB.Exists(key) Then delRows.Add rgA.Row + i - 1
    Next

    Dim r As Long
    For r = delRows.Count To 1 Step -1
        wsA.Rows(delRows(r)).Delete
    Next

    SpeedOff
    MsgBox "削除件数: " & delRows.Count
End Sub
VB
  • ポイント
    • 複合キーは「コード|年月」で連結。
    • 年月は yyyy-mm に統一して揺れ防止。

例題で練習

'例1：単一キーで削除だけ削除
Sub Example_DeleteBasic()
    DeleteOnlyDeletedRows
End Sub

'例2：見出し名で列特定して削除だけ削除
Sub Example_DeleteByHeader()
    DeleteOnlyDeletedRows_ByHeader
End Sub

'例3：複合キー（コード×年月）で削除だけ削除
Sub Example_DeleteMultiKey()
    DeleteOnlyDeletedRows_MultiKey
End Sub
VB

よくある落とし穴と対策

  • キー表記揺れで誤判定
    • 対策: NormKey（Trim＋UCase）。必要なら半角化・記号除去も。
  • 削除順で事故
    • 対策: 必ず下から削除。
  • CurrentRegionが余計な行を含む
    • 対策: 範囲を明示指定するか、合計行
スポンサーリンク
タイトルとURLをコピーしました