【ExcelVBA】オートフィルタで抽出した行を削除

ExcelVBA,オートフィルタ

サンプルデータ

都道府県データのダウンロード（zenkoku.csv）

下記のようなCSVファイルです。

基本

.EntireRow.Delete で削除

オートフィルタで行を抽出して、表示されている行を削除します。
『Ｂ列』が『青森県』である行を削除しています。

サンプルデータのファイルを開いたら、VBEの Module1 に丸ごと貼り付けてお試しください。
Sub 行抽出と行削除()

    Dim KeyWord As String
    Dim KeyColumn As Long
    
    KeyColumn = 2 '←B列
    KeyWord = "青森県" '←B列 青森県

    '行抽出
    ActiveWorkbook.ActiveSheet.UsedRange.AutoFilter _
        Field:=KeyColumn, _
        Criteria1:=KeyWord
        
    '行削除
    With ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion.Offset(1, 0)
        .EntireRow.Delete
    End With

    ActiveWorkbook.ActiveSheet.Range("A1").AutoFilter  'オートフィルタ解除
		
End Sub

結果

※青森県が削除されています。

実行前のテーブル

応用

サンプルデータ（都道府県データ）は、ページ冒頭でダウンロードリンクがあります。

.EntireRow.Delete で削除

下記は、サンプルデータのファイルを開いたら、VBEの Module1 に丸ごと貼り付けてお使いください。
求まる結果は、上記の『基本』と同じです。下記は、シートをコピーしたり、オートフィルタを設置したり等が追加されています。

『Ｂ列』が『青森県』である行を削除しています。

Option Explicit

'###############################################################
'
' サンプルデータ（都道府県データ）は、ＨＰに掲載してあります。
'
'###############################################################

Sub 主処理()
    
    Application.ScreenUpdating = False '画面更新停止
 
    Call シートコピー
    Call オートフィルタ設置
    Call 行抽出と行削除
    Call オートフィルタ解除
    
    Application.ScreenUpdating = True '画面更新再開
    
    MsgBox "新しく作成されたシートが結果になります。", vbInformation
    
    
End Sub

'-----------------------------------------
' サンプルデータのシートコピー
'-----------------------------------------
Sub シートコピー()

    ActiveWorkbook.Sheets("zenkoku").Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
    
End Sub

'-----------------------------------------
'オートフィルタをヘッダ行に設置する
'-----------------------------------------
Sub オートフィルタ設置()

    If ActiveWorkbook.ActiveSheet.FilterMode = False Then
        ActiveWorkbook.ActiveSheet.UsedRange.AutoFilter
    End If
    
End Sub

'-----------------------------------------
'行抽出と行削除
'-----------------------------------------
Sub 行抽出と行削除()

    Dim KeyWord As String
    Dim KeyColumn As Long
    
    KeyColumn = 2 '←B列
    KeyWord = "青森県" '←B列 青森県
    
    '行抽出
    ActiveWorkbook.ActiveSheet.UsedRange.AutoFilter _
        Field:=KeyColumn, _
        Criteria1:=KeyWord

    '行削除
    With ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion.Offset(1, 0)
        .Resize(.Rows.Count - 1).EntireRow.Delete
    End With

End Sub

'-----------------------------------------
'オートフィルタ解除
'-----------------------------------------
Sub オートフィルタ解除()

        ActiveWorkbook.ActiveSheet.UsedRange.AutoFilter
        
End Sub

.EntireRow.Delete の行削除が著しく遅いときの代替例

パソコンがロースペックの場合、.EntireRow.Delete メソッド処理が著しく遅くなるときがあります。
そんなときは .EntireRow.Delete を使わないで済む方法があります。.EntireRow.Delete　の代わりに 『行値クリア→行並び替え』 の順番で処理させます。これによって、ほぼ同様の結果が得られます。ほぼとは、並び替えが発生する点です。

下記のデメリットについて記載しておきます

  • コードが長くなる。
  • 並び替えが途中で必要なので、一意のコードが無いと順番が崩れる。
それでも遅いよりはマシなので、お困りの方はお試しください。

『Ｂ列』が『青森県』である行を削除しています。

Option Explicit

'###############################################################
'
' サンプルデータ（都道府県データ）は、ＨＰに掲載してあります。
'
'###############################################################

Sub 主処理()
    
    Application.ScreenUpdating = False '画面更新停止

    Call シートコピー
    Call オートフィルタ設置
    Call 行抽出
    Call 行値クリア
    Call 行並び替え
    Call 行罫線などクリア
    
    Application.ScreenUpdating = True '画面更新再開
    
    MsgBox "新しく作成されたシートが結果になります。", vbInformation
    
End Sub

'-----------------------------------------
' サンプルデータのシートコピー
'-----------------------------------------
Sub シートコピー()

    ActiveWorkbook.Sheets("zenkoku").Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
    
End Sub

'-----------------------------------------
'オートフィルタをヘッダ行に設置する
'-----------------------------------------
Sub オートフィルタ設置()

    If ActiveWorkbook.ActiveSheet.FilterMode = False Then
        ActiveWorkbook.ActiveSheet.UsedRange.AutoFilter
    End If
    
End Sub

'-----------------------------------------
'オートフィルタで行抽出
'-----------------------------------------
Sub 行抽出()

    Dim KeyWord As String
    Dim KeyColumn As Long
    
    KeyColumn = 2 '←B列
    KeyWord = "青森県" '←B列 青森県
    
    ActiveWorkbook.ActiveSheet.UsedRange.AutoFilter _
        Field:=KeyColumn, _
        Criteria1:=KeyWord
        
End Sub

'-----------------------------------------
'抽出行の値クリア
'-----------------------------------------
Sub 行値クリア()

    ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    ActiveWorkbook.ActiveSheet.Range("A1").AutoFilter  'オートフィルタ解除
    
End Sub

'-----------------------------------------
'行全体を並び替え（昇順：xlAscending）
'-----------------------------------------
Sub 行並び替え()

    Dim SortColumn As Long
    
    SortColumn = 1 '←A列 を基準にソート
    
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Cells(1, SortColumn), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange ActiveWorkbook.ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

'-----------------------------------------
' サンプルデータに罫線などありませんが一応掲載
'-----------------------------------------
Sub 行罫線などクリア()

    'テーブルの最終行付近に残る罫線をまとめてクリア
    
    Dim TargetColumn As Long
    
    TargetColumn = 1 '←A列にテーブルの最終行が存在するものとする（文字が存在するものとする）

    With ActiveWorkbook.ActiveSheet.Cells(Rows.Count, TargetColumn).End(xlUp)
        ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion.Offset(.Row).Clear
    End With
    
End Sub