テーブルから、行すべてのセルが空白の場合にその行を削除するサブルーチン
以下がタイトルのサブルーチンです。
Private Sub TableRowBlankToDelete(ByRef tbl As ListObject)
Dim rng As Range
Dim rowToDelete As Range
Dim cell As Range
Dim Row As Range
' データボディの範囲を取得
Set rng = tbl.DataBodyRange
' 各行に対して処理
For Each Row In rng.Rows
' 行内のすべてのセルが空白かどうかをチェック
If WorksheetFunction.CountA(Row) = 0 Then
' 空白行の場合、その行を rowToDelete に追加
If rowToDelete Is Nothing Then
Set rowToDelete = Row
Else
Set rowToDelete = Union(rowToDelete, Row)
End If
End If
Next Row
' rowToDelete がある場合、その行を削除
If Not rowToDelete Is Nothing Then
rowToDelete.Delete
Else
MsgBox "空白行が見つかりませんでした。"
End If
End Sub
' 空白行が見つかった場合、その行全体を rowToDelete に追加し、
' 最後に一括して削除します。
使用例は、以下です。
Private Sub 使用例()
Dim tbl As ListObject
' テーブルを取得
Set tbl = ActiveSheet.ListObjects(1)
Call TableRowBlankToDelete(tbl)
End Sub
引数にテーブルを指定して、サブルーチンを呼び出すと、実行でします。
このテーブルで実行すると、以下のように、行すべてのセルが空白の場合、その行を削除されます。