Dim zzループ用セル As Range 'Forループ用のRange型変数
Dim zz対象セル As Range '削除対象のセルの代入先のRange型変数
'指定セル範囲を全てループする
For Each zzループ用セル In Range("A2:A16")
'セルが空白なら削除対象とする
If zzループ用セル = "" Then
'対象セル変数が取得されているかで分岐
If zz対象セル Is Nothing Then
Set zz対象セル = zzループ用セル
Else
'取得されていればUnionメソッドを使用してセル範囲を追加
Set zz対象セル = Union(zz対象セル, zzループ用セル)
End If
Else: End If
Next zzループ用セル
'ループ終了後にセルが取得されているかを判定
If Not zz対象セル Is Nothing Then
'取得されていれば対象範囲を削除する
zz対象セル.EntireRow.Delete
'↓テーブル機能利用時はテーブルの列範囲内でなければエラーとなるので以下を利用する
'Intersect(zz対象セル.EntireRow, Range("A:D")).Delete
Set zz対象セル = Nothing
Else: End If
ループ処理で判定を行いつつ不要行の削除や挿入を行う際には、実際の削除処理を実行するタイミングが処理上で注意が必要です
というのも、セルのループをする場合は基本はForEachループを利用しますが、このループ処理では最初に指定のセル範囲を代入することになります
ループ中に削除を行うと、代入したセル範囲が矛盾を起こしてしまいます
処理の組み方次第では実行時エラーとなります
ループ処理で削除や挿入を行う際には、ループ処理中にメソッドは実行せずに対象セルを取得して、ループが終了してから一括で実行することで矛盾の発生を無くす事と処理速度の向上を実現できます
その際に利用するのはRange型の変数だけです
この変数に削除対象となるセル自体を代入していきます
ただ削除対象をそのままループで代入しても、前回のセルが上書きされてしまいますのでUnionメソッドを利用してセル範囲を追加していきます
ループ判定が終了した段階で、対象セルが取得されていればその範囲に対して一括でDeleteメソッドで削除を行います
コード利用の意味について
この目的は空白行など不要な行を削除するだけの処理です
なので、特別な処理は必要なく単純にIF分岐を利用して条件に一致する行を削除してしまえば良いだけに感じると思います
この画像は処理を実行する前の状況の画像です
このシートのテーブルデータのうち、A列のセルが空白になっている行を削除したい処理になります
コードはうまくいかないコードなので、画像内で見にくいですが確認してください
流れとしてはA列の指定セル範囲をForEachループで回しています
その際にセルが空白であれば行全体を削除しています
こちらの画像が処理を実際に実行したあとのモノです
一見して分かるように空白行が残ってしまっています
さらに確認してもらいたいのが、画像左下のイミディエイトに出力されたループ処理で実行されたセルのAddress文字列です
ForEachループではA2～A16までを代入して実行しているのに、A11までしかループが実行されていません
これはループ中に削除を行うことにより対象のセル数が減少していること
さらに削除した時点で、ForEachループの参照するセルが存在しなくなったことで自動的に次のセルを参照してしまっているため、連続した空白行の部分がうまく処理できていない状況です
これはそもそも仕様に対処する場合には、ループ処理を上からではなく下から行うことで対処することは出来ます
ですがその場合ForEachループは利用できなくなります
コード解説
記事コードの流れで処理を組むことで、目的の達成と処理速度の向上を図れます
この画像は上記のコード実行前から記事コードを実行した後の状態の画像です
今回はしっかりと空白行が無くなっていることが分かると思います
この画像はイミディエイトに出力されたものです
ForEachループで指定したセル全てがしっかり処理されていることが確認できると思います
Dim zzループ用セル As Range 'Forループ用のRange型変数 Dim zz対象セル As Range '削除対象のセルの代入先のRange型変数
最初に使用する変数の宣言です
この処理ではRange型変数を2個使用します
1つはForEachループ用の変数です
もう1つは削除対象のセルを取得する変数です
ここに代入したセル範囲に対して削除を実行します
'指定セル範囲を全てループする
For Each zzループ用セル In Range("A2:A16")
～～中略～～
Next zzループ用セル
ForEachループの個所です
ここではとりあえずとして、セル範囲は決め打ちの処理になっています
実際にはワークシートのセル範囲であればUsedRangeやCurrentRegionのプロパティや画像のようなテーブル範囲であればListObjectsオブジェクトの各プロパティ等を利用してセル範囲を取得してください
'セルが空白なら削除対象とする If zzループ用セル = "" Then ～～中略～～ Else: End If
削除条件を設定するIF分岐個所になります
ここの条件を変更することで削除対象を変更することが出来ます
逆に空白ではない行を削除したり、特定の値を対象とすることも出来ます
'対象セル変数が取得されているかで分岐 If zz対象セル Is Nothing Then Set zz対象セル = zzループ用セル Else '取得されていればUnionメソッドを使用してセル範囲を追加 Set zz対象セル = Union(zz対象セル, zzループ用セル) End If
削除条件に一致するセルであった場合は対象セル変数に代入させます
しかし、そのまま代入すると新しいセルで上書きされていってしまいますので、すでに取得対象が存在する場合は既存のセル範囲を残して追加する必要があります
そのためUnionメソッドを利用して、取得済み範囲に追加してきます
ただ、このメソッドは2つ以上のセル範囲を追加するメソッドのため
未取得のNothingではエラーとなります
そのため、最初に取得済みかどうかの判定を行ってから、取得済みでなければループ変数のセル範囲を代入して、取得済みであれば既存の範囲に追加します
この後で行全体選択のプロパティ等を利用するので、この時点の取得範囲はセル単体の追加でも問題はありません
'ループ終了後にセルが取得されているかを判定
If Not zz対象セル Is Nothing Then
'取得されていれば対象範囲を削除する
zz対象セル.EntireRow.Delete
'↓テーブル機能利用時はテーブルの列範囲内でなければエラーとなるので以下を利用する
'Intersect(zz対象セル.EntireRow, Range("A:D")).Delete
Set zz対象セル = Nothing
Else: End If
ここはループを抜けてきた後の処理になります
ループはあくまでも削除対象のセルを判定して取得を行うためのものになります
つまり、この時点で削除対象が必ず存在しているということは分かりません
ループを抜けてきた時点で対象セル変数がNothing（初期値）となっているかどうかで存在確認が出来ます
Nothingはオブジェクトなので、比較演算子はIsを利用する必要があります
この比較演算子は反対の意味の演算子が無いので、Notを利用して逆説にすることで、Nothingではない（対象セルが存在する）という条件が成り立つときに削除処理を実行します
取得した対象セルは単一セルなので、行全体を指定するためにEntireRowプロパティを利用して削除を実行します
ただここで問題がある場面がテーブル機能の場合になります
テーブル機能範囲の行を削除する場合に連続していない行全体を削除しようとすると画像の実行時エラーが発生します
このエラーが発生して、Deleteメソッドが実行できません
その場合にはコメントアウトされているコードを利用してください
'↓テーブル機能利用時はテーブルの列範囲内でなければエラーとなるので以下を利用する
'Intersect(zz対象セル.EntireRow, Range("A:D")).Delete
こちらのコードはテーブル機能を利用している場合に利用するコードになります
テーブル機能の範囲を削除を行う場合には、テーブル機能の列範囲と同じ列範囲を指定する必要があります
ここでは決め打ちの列指定ですが、実際に使用する場合はDataBodyRangeプロパティ等を利用して列範囲を取得するようにするといいです
ちなみにこのセルを変数に代入させて、あとでまとめて一括で処理を行う方法は処理向上にとても貢献します
削除だけでなく、挿入やセルの書式設定等や一括入力などにも利用できます
