Excel VBA 逆引き集 | 片方にしかない行の削除

Excel VBA
スポンサーリンク

片方にしかない行の削除

「A表にはあるけどB表にはない」「B表にはあるけどA表にはない」——片側限定の行を“抽出”ではなく“削除”するテンプレです。初心者でも壊さないコツは、キーの正規化、下から削除、配列＋辞書で高速、見出し名で安全です。

方針と安全策

  • 目的の明確化: AのみをAから削除、BのみをBから削除（どちらを残すか決める）。
  • キー正規化: Trim/UCaseで表記揺れ吸収。必要なら半角化や記号除去も。
  • 下から削除: ループは必ず最終行→1行へ。行ズレ事故を防ぐ。
  • 配列＋辞書: 大量行でも高速・安定。セル往復をしない。
  • 見出し名参照: 列順が変わっても壊れないようヘッダーから列位置取得。

最短テンプレ：Aのみ/Bのみを削除（単一キー・辞書版）

「Aにしかない行は削除」「Bにしかない行は削除」を一気に行います。A/BともにA列=コードの想定。

Option Explicit

Sub Delete_OnlyOneSide_Basic()
    'A: Sheet("A") A=コード, 以降任意
    'B: Sheet("B") A=コード, 以降任意
    Dim wsA As Worksheet: Set wsA = Worksheets("A")
    Dim wsB As Worksheet: Set wsB = Worksheets("B")

    Dim lastA As Long: lastA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    Dim lastB As Long: lastB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row

    'Bキー集合（辞書）
    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim r As Long, k As String
    For r = 2 To lastB
        k = UCase$(Trim$(CStr(wsB.Cells(r, "A").Value)))
        If Len(k) > 0 Then setB(k) = True
    Next

    'AのみをAから削除（下から）
    For r = lastA To 2 Step -1
        k = UCase$(Trim$(CStr(wsA.Cells(r, "A").Value)))
        If Len(k) > 0 And Not setB.Exists(k) Then
            wsA.Rows(r).Delete
        End If
    Next

    'Aキー集合
    Dim setA As Object: Set setA = CreateObject("Scripting.Dictionary")
    For r = 2 To wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
        k = UCase$(Trim$(CStr(wsA.Cells(r, "A").Value)))
        If Len(k) > 0 Then setA(k) = True
    Next

    'BのみをBから削除（下から）
    For r = lastB To 2 Step -1
        k = UCase$(Trim$(CStr(wsB.Cells(r, "A").Value)))
        If Len(k) > 0 And Not setA.Exists(k) Then
            wsB.Rows(r).Delete
        End If
    Next
End Sub
VB
  • ポイント
    • 辞書で存在判定: setBに無ければAのみ→削除。逆も同様。
    • 下から削除: 行インデックスのズレを完全に回避。

見出し名で安全に削除（列順変更に強い）

列順が変わる現場向け。見出し名からキー列位置を取得して削除します。

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 Delete_OnlyOneSide_ByHeaders()
    Dim rgA As Range: Set rgA = Worksheets("A").Range("A1").CurrentRegion
    Dim rgB As Range: Set rgB = Worksheets("B").Range("A1").CurrentRegion
    Dim wsA As Worksheet: Set wsA = rgA.Worksheet
    Dim wsB As Worksheet: Set wsB = rgB.Worksheet

    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 MsgBox "キー見出し不足（コード）": Exit Sub

    Dim lastA As Long: lastA = rgA.Rows.Count
    Dim lastB As Long: lastB = rgB.Rows.Count

    'Bキー集合
    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim r As Long, k As String
    For r = 2 To lastB
        k = UCase$(Trim$(CStr(rgB.Cells(r, cKeyB).Value)))
        If Len(k) > 0 Then setB(k) = True
    Next

    'Aのみ削除（下から）
    For r = lastA To 2 Step -1
        k = UCase$(Trim$(CStr(rgA.Cells(r, cKeyA).Value)))
        If Len(k) > 0 And Not setB.Exists(k) Then
            rgA.Rows(r).Delete
        End If
    Next

    'Aキー集合再作成（削除後）
    Dim setA As Object: Set setA = CreateObject("Scripting.Dictionary")
    Dim lastA2 As Long: lastA2 = wsA.Range("A1").CurrentRegion.Rows.Count
    For r = 2 To lastA2
        k = UCase$(Trim$(CStr(wsA.Range("A1").CurrentRegion.Cells(r, cKeyA).Value)))
        If Len(k) > 0 Then setA(k) = True
    Next

    'Bのみ削除（下から）
    For r = lastB To 2 Step -1
        k = UCase$(Trim$(CStr(rgB.Cells(r, cKeyB).Value)))
        If Len(k) > 0 And Not setA.Exists(k) Then
            rgB.Rows(r).Delete
        End If
    Next
End Sub
VB
  • ポイント
    • 壊れない列参照: 見出し名で列位置を動的取得。
    • 削除後の再計算: A側を削った後にAキー集合を作り直してB削除へ。

複数キーの片側削除（例：コード×年月）

年月なども含めた複合キーで、片側だけの行を削除します。

Sub Delete_OnlyOneSide_MultiKey()
    'A: A=コード, B=年月, 以降任意
    'B: A=コード, B=年月, 以降任意
    Dim wsA As Worksheet: Set wsA = Worksheets("A")
    Dim wsB As Worksheet: Set wsB = Worksheets("B")
    Dim lastA As Long: lastA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    Dim lastB As Long: lastB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row

    'B複合キー集合 key="コード|yyyy-mm"
    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim r As Long, key As String, ym As String
    For r = 2 To lastB
        ym = IIf(IsDate(wsB.Cells(r, "B").Value), Format$(CDate(wsB.Cells(r, "B").Value), "yyyy-mm"), CStr(wsB.Cells(r, "B").Value))
        key = UCase$(Trim$(CStr(wsB.Cells(r, "A").Value))) & "|" & UCase$(Trim$(ym))
        setB(key) = True
    Next

    'Aのみ削除（下から）
    For r = lastA To 2 Step -1
        ym = IIf(IsDate(wsA.Cells(r, "B").Value), Format$(CDate(wsA.Cells(r, "B").Value), "yyyy-mm"), CStr(wsA.Cells(r, "B").Value))
        key = UCase$(Trim$(CStr(wsA.Cells(r, "A").Value))) & "|" & UCase$(Trim$(ym))
        If Not setB.Exists(key) Then wsA.Rows(r).Delete
    Next

    'A複合キー集合を作成（削除後）
    Dim setA As Object: Set setA = CreateObject("Scripting.Dictionary")
    For r = 2 To wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
        ym = IIf(IsDate(wsA.Cells(r, "B").Value), Format$(CDate(wsA.Cells(r, "B").Value), "yyyy-mm"), CStr(wsA.Cells(r, "B").Value))
        key = UCase$(Trim$(CStr(wsA.Cells(r, "A").Value))) & "|" & UCase$(Trim$(ym))
        setA(key) = True
    Next

    'Bのみ削除（下から）
    For r = lastB To 2 Step -1
        ym = IIf(IsDate(wsB.Cells(r, "B").Value), Format$(CDate(wsB.Cells(r, "B").Value), "yyyy-mm"), CStr(wsB.Cells(r, "B").Value))
        key = UCase$(Trim$(CStr(wsB.Cells(r, "A").Value))) & "|" & UCase$(Trim$(ym))
        If Not setA.Exists(key) Then wsB.Rows(r).Delete
    Next
End Sub
VB
  • ポイント
    • 年月の統一: yyyy-mmで表記統一して比較ミス防止。
    • 安全区切り: "|" のようなデータに出にくい記号で連結。

削除が不安なら“フラグ列”で確認してから削除

直接消すのが怖いときは、まずフラグ列に「Aのみ」「Bのみ」を立ててから、ユーザーが確認後に削除します。

Sub Mark_OnlyOneSide_ThenDelete()
    Dim wsA As Worksheet: Set wsA = Worksheets("A")
    Dim wsB As Worksheet: Set wsB = Worksheets("B")
    Dim lastA As Long: lastA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    Dim lastB As Long: lastB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row

    'Bキー集合
    Dim setB As Object: Set setB = CreateObject("Scripting.Dictionary")
    Dim r As Long, k As String
    For r = 2 To lastB
        k = UCase$(Trim$(CStr(wsB.Cells(r, "A").Value)))
        If Len(k) > 0 Then setB(k) = True
    Next

    'A側にフラグ
    wsA.Cells(1, "Z").Value = "片側フラグ"
    For r = 2 To lastA
        k = UCase$(Trim$(CStr(wsA.Cells(r, "A").Value)))
        wsA.Cells(r, "Z").Value = IIf(Len(k) > 0 And Not setB.Exists(k), "Aのみ", "")
    Next

    '確認ダイアログ
    If MsgBox("Z列のフラグを確認しましたか？ フラグ付き行を削除しますか？", vbYesNo + vbQuestion) = vbYes Then
        For r = lastA To 2 Step -1
            If wsA.Cells(r, "Z").Value = "Aのみ" Then wsA.Rows(r).Delete
        Next
        wsA.Columns("Z").ClearContents
    End If
End Sub
VB
  • ポイント
    • 確認プロセス: 誤削除防止。監査にも使える。
    • フラグ列は最後に片付け: 後残りを防ぐ。

実務の落とし穴と対策

  • 重複キーがあると誤削除
    • 対策: 削除前に重複監査（辞書で検出し、一覧を作る）。
  • 空白やNull相当のキー
    • 対策: Len(key)=0 は無視。必要なら別リストへ。
  • 削除が遅い（大量行）
    • 対策: Application.ScreenUpdating/Calculation/Events を停止→復帰。必要ならフィルタで可視行まとめ削除も検討。
  • 列順変更で壊れる
    • 対策: 見出し名で列位置特定。ハードコードしない。
  • バックアップなしで削除して後悔
    • 対策: 事前にブック複製、またはフラグ→ユーザー確認→削除の二段構え。

例題で練習

'例1：基本（Aのみ/Bのみを削除）
Sub Example_DeleteBasic()
    Delete_OnlyOneSide_Basic
End Sub

'例2：見出し名対応で安全に削除
Sub Example_DeleteByHeaders()
    Delete_OnlyOneSide_ByHeaders
End Sub

'例3：複数キー（コード×年月）の片側削除
Sub Example_DeleteMultiKey()
    Delete_OnlyOneSide_MultiKey
End Sub

'例4：フラグを立ててからユーザー確認→削除
Sub Example_MarkThenDelete()
    Mark_OnlyOneSide_ThenDelete
End Sub
VB

スポンサーリンク
タイトルとURLをコピーしました