2022年3月 プログラムの話 その1 【修正】

えっと、今回も EXCEL VBA の備忘録です。

以前の記事で乗せていたテーブルの全削除メソッドは数式まで消してしまうのですが、それではちょっと使いづらい状況が発生しまして、数式を残して削除するように改造しました。

『2021年12月 プログラムの話 その1』

かといって、全セルのチェックをしていては遅くて使い物にならないので、ちょっとトンチを利かせまして…。

①：最初の1行だけ残して、そこから下の全セルを一括削除

②：残った1行の中で数式の入っていないセルのデータを削除

③：数式以外が削除されると数式も計算できなくなって初期値になる

という手順で、全セルのチェックは1行分だけとしております。

実装内容は以下の通り。

テーブルの全レコードを削除する（数式は残す）

' テーブルのデータを削除する（数式は残す）
Public Sub ClearTable(ByRef sheet As Worksheet, ByVal table As String)

    ' テーブルの表示
    Dim tbl As ListObject
    Set tbl = sheet.ListObjects(table)
    
    ' 絞り込みの解除
    tbl.ShowAutoFilter = False
    tbl.ShowAutoFilter = True
    
    ' 全データの削除
    If Not (tbl.DataBodyRange Is Nothing) Then
        ' データ範囲を取得
        Dim rng As Range
        Set rng = tbl.DataBodyRange
        
        ' データの1行目より下を一括削除
        If rng.Rows.Count > 1 Then
            Dim s As String, e As String
            s = rng(2, 1).Address
            e = rng(rng.Rows.Count, rng.Columns.Count).Address
            sheet.Range(s & ":" & e).Delete
        End If
        Set rng = Nothing
        
        ' 残りの数式セル以外を削除
        Set rng = tbl.DataBodyRange
        Dim r As Range
        For Each r In rng
            If r.HasFormula = False Then
                r.ClearContents
            End If
        Next
        Set rng = Nothing
    End If
    Set tbl = Nothing

End Sub

※修正箇所

①：データ削除時に行削除を実行していたが、同じシート内に複数のテーブルが横並びで配置されていた場合にまとめて削除されてしまうので、削除範囲の指定方法を変更しました。

②：オートフィルタが有効ではない（もしくはオートフィルタが存在しない）場合に Worksheet.ShowAllData を実行するとエラーが発生するため、Worksheet.FilterMode の値でオートフィルタの有効・無効を確認するように変更しました。

※修正箇所 2022/04/08

①：同じワークシート上に複数のテーブルが設定されていた場合に、Worksheet.FilterMode 、 Worksheet.ShowAllData では判定できないことが分かったため、ListObject.ShowAutoFilter を解除→設定とすることで、指定テーブルのオートフィルタのみを解除するように変更しました。