テーブルから、行すべてのセルが空白の場合にその行を削除するサブルーチン

以下がタイトルのサブルーチンです。

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

引数にテーブルを指定して、サブルーチンを呼び出すと、実行でします。

このテーブルで実行すると、以下のように、行すべてのセルが空白の場合、その行を削除されます。

削除後テーブル

Follow me!