Excelマクロで条件に合う行を自動削除・抽出する方法10選【完全一致・部分一致・数値・日付・複数条件対応】

Office365/VBA/XLSX/

Excelで「ステータスがキャンセルの行をすべて削除したい」「売上ゼロの行だけを抽出したい」「空白行をまとめて消したい」という作業を手作業で行っていないでしょうか。データが数百行・数千行になるとフィルタをかけて目視で確認して削除する作業は非常に時間がかかり、抜け漏れも発生しやすくなります。VBAマクロを使えば、どんな件数のデータでも条件に合う行の削除・抽出をボタン1つで自動処理できます。本記事では、行削除・行抽出それぞれのパターン別サンプルコードを実務で使える形でまとめて解説します。

行削除マクロを書く前に必ず知っておくべき3つのルール

行削除のマクロを書く際に知っておかないと、意図しないバグや動作不良が発生します。コードを書き始める前に以下の3つのルールを必ず把握しておきましょう。

ルール1：削除系のループは必ず後ろから前に向かって処理する

行を削除するループ処理では、前から順番にループを回してはいけません。前から削除すると、削除した行の分だけ後続の行番号がずれてしまい、一部の行がスキップされる不具合が発生します。削除系のループは必ず最終行から1行目に向かって逆順（Step -1）でループしてください。

' ============================
' 誤った例：前から順に削除するとインデックスがずれる
' ============================
Sub 誤り_前からループ()
    Dim i As Long
    Dim 最終行 As Long
    最終行 = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To 最終行          ' ← 前からループはNG
        If Cells(i, 1).Value = "キャンセル" Then
            Rows(i).Delete       ' 削除すると次の行がずれてスキップされる
        End If
    Next i
End Sub

' ============================
' 正しい例：後ろから前にループする（Step -1）
' ============================
Sub 正しい_後ろからループ()
    Dim i As Long
    Dim 最終行 As Long
    最終行 = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 最終行 To 2 Step -1  ' ← Step -1で後ろから前にループ
        If Cells(i, 1).Value = "キャンセル" Then
            Rows(i).Delete       ' 後ろから削除するので行番号がずれない
        End If
    Next i
End Sub

ルール2：実行前に必ずファイルを保存またはバックアップする

VBAで行を削除すると、Ctrl+Z（元に戻す）が使えません。一度実行すると削除前の状態に戻す手段がなくなるため、マクロを実行する前に必ずCtrl+Sでファイルを保存するか、別名でバックアップコピーを作成してください。

' マクロの先頭でバックアップを自動作成するコード
Sub バックアップ付き削除マクロ()
    ' 実行前に同じフォルダに「元のファイル名_backup.xlsx」として保存
    Dim バックアップパス As String
    バックアップパス = ThisWorkbook.Path & "\" & _
        Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & _
        "_backup.xlsm"
    ThisWorkbook.SaveCopyAs バックアップパス

    ' ===== 削除処理をここに書く =====

    MsgBox "処理が完了しました。バックアップ先：" & バックアップパス
End Sub

ルール3：最終行の取得は必ずCells(Rows.Count, 1).End(xlUp).Rowで行う

削除処理では処理範囲の最終行を動的に取得することが重要です。固定の行番号でループ範囲を指定すると、データが増減したときにコードが正しく動作しなくなります。

' 最終行の正しい取得方法
Dim 最終行 As Long

' 方法1（推奨）：A列の下から上方向に最初にデータがあるセルを探す
最終行 = Cells(Rows.Count, 1).End(xlUp).Row
' → A列にデータが途切れる可能性がある場合でも最終行を正確に取得できる

' 方法2：A列の上から下方向に最後のデータセルを探す（空白がない場合のみ有効）
最終行 = Range("A1").End(xlDown).Row
' → A列に空白セルがある場合は空白の手前で止まるため注意が必要

' 方法3：UsedRangeを使う
最終行 = ActiveSheet.UsedRange.Rows.Count
' → 書式だけ設定されたセルも含んでしまうため誤差が出やすい（非推奨）

条件付き行削除のサンプルコード集

パターン1：特定の文字列と完全一致する行を削除する

最も基本的なパターンです。「ステータスが『キャンセル』の行を削除する」「都道府県が『東京』の行を削除する」など、特定の値と完全一致する行をすべて削除します。

' ============================
' A列が「キャンセル」と完全一致する行を削除する
' ============================
Sub 完全一致行削除()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False  ' 画面更新を停止して高速化

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1  ' 2行目はヘッダーの次行・1行目はヘッダーのため除外
        If Cells(i, 1).Value = "キャンセル" Then
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

パターン2：特定の文字列を「含む」行を削除する（部分一致）

「備考欄に『不要』という文字が含まれている行」「商品名に『廃番』が含まれる行」など、部分一致での削除はLike演算子またはInStr関数を使います。

' ============================
' A列に「不要」という文字列を含む行を削除する（Like演算子・部分一致）
' ============================
Sub 部分一致行削除_Like()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        ' Like演算子でワイルドカード（*）を使って部分一致を判定する
        If Cells(i, 1).Value Like "*不要*" Then
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

' ============================
' InStr関数を使った部分一致削除（文字の位置も取得できる）
' ============================
Sub 部分一致行削除_InStr()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        ' InStr(対象文字列, 検索文字列) → 見つかった位置を返す（0なら含まれない）
        If InStr(Cells(i, 1).Value, "不要") > 0 Then
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

パターン3：数値の条件（以下・以上・範囲）で行を削除する

「売上が0以下の行を削除する」「在庫数が10未満の行を削除する」「評価点が50以上70未満の行を削除する」など、数値の大小条件での削除です。

' ============================
' C列の値が0以下（ゼロまたはマイナス）の行を削除する
' ============================
Sub 数値条件行削除_以下()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        ' IsNumeric関数で数値かどうかを確認してから比較する
        If IsNumeric(Cells(i, 3).Value) Then
            If Cells(i, 3).Value <= 0 Then
                Rows(i).Delete
            End If
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

' ============================
' D列の値が50以上かつ70未満の行を削除する（範囲指定）
' ============================
Sub 数値範囲行削除()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        If IsNumeric(Cells(i, 4).Value) Then
            ' AND条件で範囲を指定する
            If Cells(i, 4).Value >= 50 And Cells(i, 4).Value < 70 Then
                Rows(i).Delete
            End If
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

パターン4：複数条件（AND・OR）で行を削除する

「受注数が空白かつ備考に『削除』が含まれている行」「ステータスがキャンセルまたは保留の行」など、複数の条件を組み合わせた削除です。

' ============================
' A列が空白 かつ B列に「削除」または「不要」を含む行を削除する（AND条件）
' ============================
Sub 複数条件AND削除()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        ' AND条件：A列が空白 かつ B列に「削除」または「不要」を含む
        If Cells(i, 1).Value = "" And _
           (Cells(i, 2).Value Like "*削除*" Or Cells(i, 2).Value Like "*不要*") Then
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

' ============================
' A列が「キャンセル」または「保留」または「却下」のいずれかの行を削除する（OR条件）
' ============================
Sub 複数条件OR削除()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        Select Case Cells(i, 1).Value
            Case "キャンセル", "保留", "却下"  ' いずれかに一致したら削除
                Rows(i).Delete
        End Select
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

パターン5：空白行を一括削除する

データを整理したあとに残る空白行や、インポートデータに混じった空白行をすべて削除するパターンです。実務で非常に頻繁に使います。

' ============================
' A列が空白の行をすべて削除する
' ============================
Sub 空白行削除_A列基準()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        If Cells(i, 1).Value = "" Then
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "空白行の削除が完了しました。"
End Sub

' ============================
' 行全体が空白の行のみ削除する（1列でも値があれば残す）
' ============================
Sub 行全体空白行削除()
    Dim i As Long
    Dim 最終行 As Long
    Dim 最終列 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row
    最終列 = Cells(1, Columns.Count).End(xlToLeft).Column  ' 使用している最終列を取得

    For i = 最終行 To 2 Step -1
        ' WorksheetFunction.CountAで行内のデータ件数を確認する
        ' 0件（すべて空白）の行だけを削除する
        If WorksheetFunction.CountA(Rows(i)) = 0 Then
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "行全体が空白の行の削除が完了しました。"
End Sub

パターン6：オートフィルタを使った高速削除（大量データ向け）

ループして1行ずつ削除する方法よりもオートフィルタを使って一括削除する方法の方が10倍以上高速になるため、データが数万行以上ある場合はオートフィルタを使った方法が推奨されます。

' ============================
' オートフィルタを使ってC列が「0」の行を高速に削除する
' ============================
Sub オートフィルタ高速削除()
    Dim 削除対象範囲 As Range

    Application.ScreenUpdating = False

    ' フィルタをかける前に既存のオートフィルタをリセットする
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If

    ' C列（3列目）が「0」の行をオートフィルタで絞り込む
    With Range("A1").CurrentRegion
        .AutoFilter Field:=3, Criteria1:="0"  ' 3列目が「0」の行を抽出

        ' フィルタ結果の行が存在する場合のみ削除する
        If WorksheetFunction.Subtotal(103, Range("A:A")) > 1 Then
            ' ヘッダー行を除いた可視セルの行を取得して削除する
            Set 削除対象範囲 = .Offset(1, 0).Resize(.Rows.Count - 1) _
                .SpecialCells(xlCellTypeVisible)
            削除対象範囲.EntireRow.Delete
        End If

        ' フィルタを解除する
        .AutoFilter
    End With

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

行抽出のサンプルコード集

パターン7：条件に合う行を別シートに抽出・コピーする

「完了ステータスの行だけを別シートに抽出する」「特定の担当者の行だけを集めて別シートに出力する」など、元データを残しながら条件に合う行だけを別シートにコピーするパターンです。

' ============================
' A列が「完了」の行を「抽出結果」シートにコピーする
' ============================
Sub 条件行を別シートに抽出()
    Dim 元シート As Worksheet
    Dim 抽出シート As Worksheet
    Dim i As Long
    Dim 最終行 As Long
    Dim 抽出行 As Long

    Set 元シート = ThisWorkbook.Worksheets("データ")      ' 元データのシート名
    Set 抽出シート = ThisWorkbook.Worksheets("抽出結果")  ' 抽出先のシート名

    Application.ScreenUpdating = False

    ' 抽出先シートをクリアする（ヘッダー行は残す）
    If 抽出シート.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
        抽出シート.Rows("2:" & 抽出シート.Cells(Rows.Count, 1).End(xlUp).Row).Delete
    End If

    最終行 = 元シート.Cells(Rows.Count, 1).End(xlUp).Row
    抽出行 = 2  ' 抽出先の書き込み開始行（2行目からスタート・1行目はヘッダー）

    For i = 2 To 最終行  ' 抽出はヘッダーを除いて前からループしてよい
        If 元シート.Cells(i, 1).Value = "完了" Then
            ' 条件に合う行全体をコピーして抽出シートに貼り付ける
            元シート.Rows(i).Copy Destination:=抽出シート.Rows(抽出行)
            抽出行 = 抽出行 + 1
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox (抽出行 - 2) & " 件のデータを抽出しました。"
End Sub

パターン8：条件に合う行を値のみ別シートに抽出する（書式なし）

書式をコピーせずに値だけを別シートに転記したい場合は、Copyの代わりにセルの値を直接代入します。

' ============================
' B列が特定の値の行を、値のみ別シートに抽出する（書式なし転記）
' ============================
Sub 条件行値のみ抽出()
    Dim 元シート As Worksheet
    Dim 抽出シート As Worksheet
    Dim i As Long
    Dim 最終行 As Long
    Dim 最終列 As Long
    Dim 抽出行 As Long

    Set 元シート = ThisWorkbook.Worksheets("データ")
    Set 抽出シート = ThisWorkbook.Worksheets("抽出結果")

    Application.ScreenUpdating = False

    最終行 = 元シート.Cells(Rows.Count, 1).End(xlUp).Row
    最終列 = 元シート.Cells(1, Columns.Count).End(xlToLeft).Column
    抽出行 = 抽出シート.Cells(Rows.Count, 1).End(xlUp).Row + 1  ' 既存データの下に追加

    For i = 2 To 最終行
        If 元シート.Cells(i, 2).Value = "東京" Then
            ' 行全体の値を抽出シートの対応する列にそのままコピーする
            抽出シート.Cells(抽出行, 1).Resize(1, 最終列).Value = _
                元シート.Cells(i, 1).Resize(1, 最終列).Value
            抽出行 = 抽出行 + 1
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "抽出が完了しました。"
End Sub

パターン9：オートフィルタを使った高速抽出

データ量が多い場合は、ループではなくオートフィルタで絞り込んでからコピーする方法が高速です。

' ============================
' オートフィルタで絞り込んで別シートに一括コピーする（高速版）
' ============================
Sub オートフィルタ高速抽出()
    Dim 元シート As Worksheet
    Dim 抽出シート As Worksheet
    Dim 抽出対象範囲 As Range

    Set 元シート = ThisWorkbook.Worksheets("データ")
    Set 抽出シート = ThisWorkbook.Worksheets("抽出結果")

    Application.ScreenUpdating = False

    ' 抽出先シートをクリアする
    抽出シート.Cells.Clear

    ' 既存フィルタをリセットする
    If 元シート.AutoFilterMode Then 元シート.AutoFilterMode = False

    ' A列（1列目）が「完了」の行を絞り込む
    元シート.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:="完了"

    ' 可視セル（フィルタ結果）をコピーして抽出シートに貼り付ける
    On Error Resume Next  ' 該当なしのときのエラーを回避
    Set 抽出対象範囲 = 元シート.Range("A1").CurrentRegion _
        .SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not 抽出対象範囲 Is Nothing Then
        抽出対象範囲.Copy Destination:=抽出シート.Range("A1")
    Else
        MsgBox "条件に合うデータが見つかりませんでした。"
    End If

    ' フィルタを解除する
    元シート.AutoFilterMode = False

    Application.ScreenUpdating = True
    MsgBox "抽出が完了しました。"
End Sub

パターン10：日付条件で行を抽出・削除する

「今月分のデータだけを抽出する」「指定した期間より古い行を削除する」など、日付を条件にした処理も実務でよく使います。

' ============================
' D列の日付が今月のデータのみを抽出する
' ============================
Sub 今月データ抽出()
    Dim i As Long
    Dim 最終行 As Long
    Dim 抽出行 As Long
    Dim 今月初日 As Date
    Dim 今月末日 As Date
    Dim 元シート As Worksheet
    Dim 抽出シート As Worksheet

    Set 元シート = ThisWorkbook.Worksheets("データ")
    Set 抽出シート = ThisWorkbook.Worksheets("抽出結果")

    ' 今月の初日と末日を取得する
    今月初日 = DateSerial(Year(Date), Month(Date), 1)
    今月末日 = DateSerial(Year(Date), Month(Date) + 1, 0)

    Application.ScreenUpdating = False

    抽出シート.Cells.Clear
    ' ヘッダー行をコピーする
    元シート.Rows(1).Copy Destination:=抽出シート.Rows(1)

    最終行 = 元シート.Cells(Rows.Count, 1).End(xlUp).Row
    抽出行 = 2

    For i = 2 To 最終行
        ' D列のセルが日付型かつ今月の範囲内かを確認する
        If IsDate(元シート.Cells(i, 4).Value) Then
            If 元シート.Cells(i, 4).Value >= 今月初日 And _
               元シート.Cells(i, 4).Value <= 今月末日 Then
                元シート.Rows(i).Copy Destination:=抽出シート.Rows(抽出行)
                抽出行 = 抽出行 + 1
            End If
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox (抽出行 - 2) & " 件の今月データを抽出しました。" & vbCrLf & _
           "期間：" & Format(今月初日, "yyyy/m/d") & " 〜 " & Format(今月末日, "yyyy/m/d")
End Sub

' ============================
' D列の日付が1年以上前の行を削除する（古いデータのクリーンアップ）
' ============================
Sub 古いデータ削除()
    Dim i As Long
    Dim 最終行 As Long
    Dim 基準日 As Date

    基準日 = DateAdd("yyyy", -1, Date)  ' 今日から1年前の日付

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        If IsDate(Cells(i, 4).Value) Then
            If Cells(i, 4).Value < 基準日 Then
                Rows(i).Delete
            End If
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "基準日（" & Format(基準日, "yyyy/m/d") & "）以前のデータを削除しました。"
End Sub

よくあるエラーとその対処法

' ============================
' エラー対処1：削除対象が1件もない場合のSpecialCellsエラーを回避する
' ============================
Sub SpecialCellsエラー回避()
    On Error Resume Next  ' エラーを無視する設定
    Dim 対象範囲 As Range
    Set 対象範囲 = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0       ' エラー無視を解除する

    ' Nothingチェックで対象が存在するか確認してから処理する
    If Not 対象範囲 Is Nothing Then
        対象範囲.EntireRow.Delete
        MsgBox "削除が完了しました。"
    Else
        MsgBox "削除対象のデータが見つかりませんでした。"
    End If
End Sub

' ============================
' エラー対処2：オートフィルタの解除漏れを防ぐ
' ============================
Sub オートフィルタ解除確認()
    ' マクロ終了時にオートフィルタが残っていたら解除する
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
End Sub

コピペしてすぐ使えるテンプレートまとめ

' ============================
' 【削除テンプレート】条件に合う行を後ろから削除する基本形
' ============================
Sub 削除テンプレート()
    Dim i As Long
    Dim 最終行 As Long

    Application.ScreenUpdating = False

    最終行 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 最終行 To 2 Step -1
        ' ===== 削除条件をここに書く =====
        If Cells(i, 1).Value = "削除対象の値" Then
        ' ================================
            Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox "削除処理が完了しました。"
End Sub

' ============================
' 【抽出テンプレート】条件に合う行を別シートにコピーする基本形
' ============================
Sub 抽出テンプレート()
    Dim 元シート As Worksheet
    Dim 抽出シート As Worksheet
    Dim i As Long
    Dim 最終行 As Long
    Dim 抽出行 As Long

    Set 元シート = ThisWorkbook.Worksheets("データ")      ' 変更してください
    Set 抽出シート = ThisWorkbook.Worksheets("抽出結果")  ' 変更してください

    Application.ScreenUpdating = False

    抽出シート.Cells.Clear  ' 抽出先をクリアする
    元シート.Rows(1).Copy Destination:=抽出シート.Rows(1)  ' ヘッダーをコピー

    最終行 = 元シート.Cells(Rows.Count, 1).End(xlUp).Row
    抽出行 = 2

    For i = 2 To 最終行
        ' ===== 抽出条件をここに書く =====
        If 元シート.Cells(i, 1).Value = "抽出対象の値" Then
        ' ================================
            元シート.Rows(i).Copy Destination:=抽出シート.Rows(抽出行)
            抽出行 = 抽出行 + 1
        End If
    Next i

    Application.ScreenUpdating = True
    MsgBox (抽出行 - 2) & " 件を抽出しました。"
End Sub

まとめ：条件付き行削除・抽出マクロの3大ポイント

Excelマクロで条件に合う行を削除・抽出する際の重要なポイントは以下の3つです。

  • 削除系ループは必ず後ろから前に向かって処理する（Step -1）：前から削除するとインデックスがずれて一部の行がスキップされるため、削除処理では逆順ループが必須です
  • マクロ実行前にバックアップを保存する：VBAの行削除はCtrl+Zで元に戻せないため、実行前のバックアップを習慣にしましょう
  • 大量データはオートフィルタ方式で高速処理する：数万行以上のデータではループよりオートフィルタを使った一括削除の方が10倍以上高速になるため、データ量に応じて方法を使い分けましょう

本記事のテンプレートコードの「条件をここに書く」の部分を自分のデータに合わせて書き換えるだけで、すぐに実務で使えるマクロが完成します。まずはパターン1の完全一致削除のコードをコピーして試してみてください。