【VBA】オートフィルタで抽出した行以外の行を削除する

VBAコード

ここでは例として、
　・シート「sample」のセル「B2」から続く一連の範囲の表の
　・列「名前」の値が「佐藤」ではない行のみを
　・削除
します。
※「佐藤」の行のみしか無い場合は何もしません。

Sub sample()

    Dim ws As Worksheet
    Dim startRange  As Range
    Dim filterColumnName As String
    Dim filterStr As String
    Dim table As ListObject
    Dim rowCount As Long

    '対象シート
    Set ws = Worksheets("sample")
    'テーブル化する表の一番左上のセル
    Set startRange = ws.Range("B2")
    'フィルタ対象の列名
    filterColumnName = "名前"
    '対象文字列
    filterStr = "佐藤"
    
    '表をテーブル化してListObjectを取得
    Set table = ws.listObjects.Add(Source:=startRange.CurrentRegion, XlListObjectHasHeaders:=xlYes)
    
    '「フィルタ対象の列名」に「対象文字列以外」の行(削除対象の行)の行数を取得
    rowCount = WorksheetFunction.CountIf(table.ListColumns(filterColumnName).DataBodyRange, "<>" & filterStr)
    
    '0行でない場合のみ後続の処理を実施
    If (rowCount <> 0) Then
        '「フィルタ対象の列」にて「対象文字列」で絞り込み
        startRange.AutoFilter field:=table.ListColumns(filterColumnName).Index, Criteria1:="<>" & filterStr
        '絞り込んだ行(＝表示させた行)のみを削除
        Application.DisplayAlerts = False
        table.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts = True
    End If
     
    'テーブル化を解除
    With table
        .TableStyle = ""
        .Unlist
    End With
    
End Sub

実行結果

オートフィルタを利用して、条件に一致した行ではない行を削除できました。
※列「名前」の値が「佐藤」ではない行のみを削除できました。

参考①

オートフィルタを利用して、条件に一致した行のみを削除することもできます。

詳細は以下の記事をご確認ください。

参考②

重複行を削除することもできます。

詳細は以下の記事をご確認ください。

参考③

オートフィルタ関連の記事は他にもあります。

詳細は以下の記事をご確認ください。

参考④

上部に記載した通り、以前のコードは以下です。
※参考までに残しておきます。

Option Explicit

Sub sample()
    
    Dim ws As Worksheet
    Dim startRange As Range
    Dim targetStr  As String
    Dim filterColumnNumber As Integer
    Dim endRow As Double
    Dim endRange As Range
    Dim targetRowCount As Long
    Dim totalRowCount As Long
    Dim unDeleteRange As Range
    Dim deleteRange As Range
    
    '対象シート
    Set ws = Worksheets("sample")
    'オートフィルタを設定する表の一番左上のセル
    Set startRange = ws.Range("B2")
    'フィルタ等をする文字列
    targetStr = "佐藤"
    '絞り込みをする表の列番号
    filterColumnNumber = 1
    
    '最終行を取得
    endRow = startRange.End(xlDown).Row
    '最終セルを取得
    Set endRange = ws.Cells(endRow, startRange.Column)
    '「フィルタ等をする文字列と一致する行の行数」を取得
    targetRowCount = WorksheetFunction.CountIf(ws.Range(startRange, endRange), targetStr)
    '「総行数」を取得
    totalRowCount = ws.Range(startRange, endRange).Rows.count - 1
    
    '●「フィルタ等をする文字列と一致する行の行数」が0の場合
    '　⇒全ての行を削除
    '
    '●「フィルタ等をする文字列と一致する行の行数」と「総行数」が同じである場合 ※「佐藤」の行のみしか無い場合
    '　⇒何もしない
    '
    '●「フィルタ等をする文字列と一致する行の行数」と「総行数」が同じでない場合
    '　⇒「指定した文字列と一致する行」以外の行を削除
    '
    '●上記以外
    '　⇒基本的にありえないはず。何もしない
    '
    If targetRowCount = 0 Then
        
        With ws.Range(startRange, endRange)
            Set deleteRange = .Resize(.Rows.count - 1).Offset(1, 0)
            deleteRange.EntireRow.Delete
        End With
    
    ElseIf targetRowCount = totalRowCount Then
    
        '何もしない
        
    ElseIf targetRowCount <> totalRowCount Then
    
        'オートフィルタの設定をして、「絞り込みをする表の列番号」を「フィルタ等をする文字列」と一致するもので絞り込み
        startRange.AutoFilter field:=filterColumnNumber, Criteria1:=targetStr
        
        '絞り込まれた範囲(＝削除させない範囲)を取得
        With startRange.CurrentRegion
            Set unDeleteRange = .Resize(.Rows.count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
        End With
        
        'オートフィルタを解除
        startRange.AutoFilter
        
        '絞り込まれた範囲(＝削除させない範囲)を非表示
        unDeleteRange.EntireRow.Hidden = True
        
        '表示されている範囲を削除
        With startRange.CurrentRegion
            Set deleteRange = .Resize(.Rows.count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
            deleteRange.EntireRow.Delete
        End With
        
        '絞り込まれた範囲(＝削除させない範囲)を表示
        unDeleteRange.EntireRow.Hidden = False
        
    Else
    
        '基本的にありえないはず。何もしない
        
    End If

End Sub