VBA100本ノック 10本目：行の削除

公開日：2020-10-28　最終更新日：2021-02-22

VBA100本ノック 10本目：行の削除

条件により行を削除する問題です。
複数（列）条件を判定し、削除対象の行全体を削除します。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 10本目
画像のように「受注」シートに今月の受注データがあります。
受注数が空欄かつ備考欄に「削除」または「不要」の文字が含まれている行を削除してください。
行の削除は行全体を削除してください。
サンプルでは5行目と10行目を削除

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_10.xlsm
https://excel-ubara.com/vba100sample/VBA100_10.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

回答で多かったのがAutoFilterを使ったものでした。
前回からの流れというものもあったと思います。
オートフィルターは簡便であり速度も速いのですが、少々癖があり特に削除で使う場合は注意が必要です。


  
    
      Sub VBA100_10_01()

　　Dim ws As Worksheet

　　Set ws = Worksheets("受注")

　　

　　Application.ScreenUpdating = False

　　ws.AutoFilterMode = False

　　

　　Dim rng As Range

      　　With ws.Range("A1").CurrentRegion

　　　　.AutoFilter field:=3, Criteria1:=""

　　　　.AutoFilter field:=4, Criteria1:="*削除*", Operator:=xlOr, Criteria2:="*不要*"

      　　　　Set rng = Intersect(.Offset(1), .SpecialCells(xlCellTypeVisible))

      　　　　If Not rng Is Nothing Then rng.EntireRow.Delete

　　End With

　　

　　ws.AutoFilterMode = False

　　Application.ScreenUpdating = True

End Sub

素直に最下行から順に削除していってみましょう。
行数が多くなると遅いと言われますが、それは削除する行数の問題です。
実際に削除する行数が1,000行くらいなら、そんなに時間はかかりません。
今回の問題の想定であれば1行ずつでも十分だと思います。


  
    
      Sub VBA100_10_02()

　　Dim ws As Worksheet

　　Set ws = Worksheets("受注")

　　

　　Application.ScreenUpdating = False

　　

　　Dim i As Long

　　For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1

　　　　If ws.Cells(i, 3).Value = "" Then

      　　　　　　If ws.Cells(i, 4).Value Like "*削除*" Or _

　　　　　　　 ws.Cells(i, 4).Value Like "*不要*" Then

      　　　　　　　 ws.Rows(i).Delete

　　　　　　End If

　　　　End If

　　Next

　　

　　Application.ScreenUpdating = True

End Sub

削除対象行をUnionで合体していき、最後に一括で削除するVBAは補足に掲載しました。
ただしこの方法も、削除する行が飛び飛びバラバラの場合は、先の1行ずつ削除と速度はあまり変わりません。

補足

オートフィルターでの削除について

.Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
この記述だけでは、削除対象が無い場合に全件削除されてしまいます。

.Offset(1).EntireRow.Delete
このようにResizeしなければ全件削除されることは無いのですが、
1行下の空行も削除しているので、場合によっては困る場合も出てくるかもしれません。

.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
このような記述をした場合、削除対象が無いとSpecialCellsでエラー発生するので、On Error対応が必要になります。

解説に掲載したVBAは、
Set rng = Intersect(.Offset(1), .SpecialCells(xlCellTypeVisible))
このSpecialCellsは見出し行を含んでいるので必ず1件は存在するのでエラーにはなりません。
フィルターで絞り込んだ結果と、元の表範囲のデータ部との交差範囲を求めています。
これが削除対象になります。
If Not rng Is Nothing Then rng.EntireRow.Delete
削除対象が無い場合はNothingになりますので、存在する場合だけ削除しています。

2回連続実行すれば必ず削除する行は存在しなくなるので、何らかの対応を考えるようにしてください。

Unionで合体させておいて最後に一括削除

Rangeのオブジェクト変数にApplicationのUnionメソッドで削除対象行を順次合体していきます。
全ての行の処理が終了した後に、Unionで合体されたRangeオブジェクト（ここではRows）を一括で削除します。


  
    
      Sub VBA100_10_03()

      　　Dim ws As Worksheet

      　　Set ws = Worksheets("受注")

      　　

      　　Dim rng As Range

      　　Dim i As Long

      　　For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

      　　　　If ws.Cells(i, 3).Value = "" Then

      　　　　　　If ws.Cells(i, 4).Value Like "*削除*" Or _

      　　　　　　　 ws.Cells(i, 4).Value Like "*不要*" Then

      　　　　　　　　If rng Is Nothing Then

      　　　　　　　　　　Set rng = ws.Rows(i)

      　　　　　　　　Else

      　　　　　　　　　　Set rng = Union(rng, ws.Rows(i))

      　　　　　　　　End If

      　　　　　　End If

      　　　　End If

      　　Next

      　　

      　　If Not rng Is Nothing Then

      　　　　rng.EntireRow.Delete

      　　End If

      End Sub

削除対象の行が連続している場合は速いのですが、
飛び飛びバラバラの場合は、1行ずつ削除する場合と大差ないと思います。
（場合によってはかえって遅くなることも）
これらの時間は、削除する行数と連続性によって変化するので、どちらが速いとは一概には言えません。

※Union処理することで大幅に速度改善できる場合があります。

今回は、単独シートで単純にバラバラな行削除でしたが、先にも書いたように削除行が連続している場合はUnion処理することで大幅に速度改善します。
また、複数セルに同一書式を設定するような場合等々、Union処理することで速度改善できる場合は多々あります。
あくまで、今回のケースではUnionで速度改善はあまり期待できないという事です。
速度を考えるなら、オートフィルターで削除が良いでしょう。

サイト内関連ページ

第29回．セル・行・列の削除・挿入（Delete,Insert）｜VBA入門

・セルの削除・セルの挿入・セルの削除・挿入時は、Shift:=は必ず指定・行・列の削除・挿入・行・列の削除/行・列の挿入で、Shift:=は必要か・行・列の表示・非表示

第49回．Like演算子とワイルドカード｜VBA入門

・Like演算子・パターン文字列式（ワイルドカード、文字リスト、文字範囲）・Like演算子の使用例・正規表現について

第89回．オートフィルタ（AutoFilter）｜VBA入門

・Range.AutoFilterメソッド・AutoFilterModeプロパティ・AutoFilterオブジェクト・オートフィルタのVBA使用例・日付のフィルタ・オートフィルタまとめ

第102回．Intersectメソッド｜VBA入門

・Intersectメソッド・Intersectの使用例・Intersectメソッドの最後に

第103回．UnionメソッドとAreasプロパティ｜VBA入門

・Unionメソッド・Areasプロパティ・Unionメソッドで連結した結果のRangeオブジェクトの状態について・Unionメソッドの使用例・Unionメソッドの実践例

同じテーマ「VBA100本ノック」の記事

7本目：日付データの扱い
 8本目：点数の合否判定
 9本目：フィルターコピー
10本目：行の削除
11本目：セル結合の警告
 12本目：セル結合を解除
 13本目：文字列の部分フォント
 14本目：社外秘シート削除
 15本目：シートの並べ替え
 16本目：無駄な改行を削除
 17本目：重複削除（ユニーク化）

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
10本目：行の削除

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA練習問題
VBA100本ノック 10本目：行の削除