【Excel VBA】ロックされていないセルのデータをクリアする

私の職場では、ファイルの「データが入力されている箇所だけクリアしたい」といった要望がかなりあります。入力前のファイルをひな型として保存しておけばいいだけの話なのですが、「ファイルは生き物なの!計算式は日々変わって当たり前!いちいちひな型の更新なんてできない!!」だそうです。

その仕事大丈夫なの?と不安になりますが、とりあえずコードを紹介します。

目次

非ロックセルの値をクリアするコード

アクティブシートでの処理

アクティブシートの、書式設定保護でロックがかかっていないセルの値をクリアします。標準モジュールに貼り付けてマクロ非ロックセルのクリアを実行して下さい。

Public Sub 非ロックセルのクリア()
    Dim r As Range, クリア範囲 As Range

    For Each r In ActiveSheet.UsedRange
        If Not r.Locked Then
'10行目は1回目のループでは成立しないので、1回目のループは8行目を実行
            If クリア範囲 Is Nothing Then
                Set クリア範囲 = r
            Else
                Set クリア範囲 = Union(クリア範囲, r)
            End If
        End If
    Next r
'非ロックセルが一つもない場合、"クリア範囲.ClearContents"はエラーになるので回避
    If Not クリア範囲 Is Nothing Then クリア範囲.ClearContents
End Sub

Worksheet.UsedRangeプロパティ

範囲はWorksheetオブジェクトUsedRangeプロパティで指定しています。UsedRangeプロパティオブジェクトを省略できません。 サンプルの場合、Activesheetを省略するとエラーが出ます。

UsedRangeプロパティは、編集されているセル(書式設定の編集も含みます)範囲を返します。今回は参照したい範囲が「ロックがかかっていないセル(=編集されているセル)」なので、UsedRangeプロパティを使用すれば必ず参照範囲に含まれます。

Range.Lockedプロパティ

セルがロックされている場合はTrue、されていない場合はFalseを返すプロパティです。

ロックされたセル範囲を選択したい場合、UsedRangeプロパティは不適切です(Range.Locked = Trueは規定値なので「未」編集になる)。参照範囲を別の方法で取得する必要があります。

Application.Unionメソッド

公式の説明は「2 つ以上のセル範囲の集合を返します」ですが、要はCtrlキーを押しながら2つ以上のセル範囲を選択するようなイメージです。

返されるオブジェクトは一つのRangeオブジェクト(コレクション)です。サンプルの変数クリア範囲」はUnionメソッドで返されたオブジェクトが代入されていますが、クリア範囲.ClearContentsで分かるように、Unionメソッドで結合されたセル全てにClearContentsプロパティがかかっています。

Rangeオブジェクトはアドレス指定に文字数の制限があります。(Range(”××:××,〇〇:〇〇,▽▽:▽▽…”)が上限255文字)。この制限をUnionメソッドで回避できます。

指定したシートでの処理

Public Sub 非ロックセルのクリア_シート指定()
    Dim シート名 As Variant, s As Variant
    Dim r As Range, クリア範囲 As Range
    
    シート名 = Array("sheet1", "sheet2")
    
    For Each s In シート名
        For Each r In Worksheets(s).UsedRange
            If Not r.Locked Then
                If クリア範囲 Is Nothing Then
                    Set クリア範囲 = r
                Else
                    Set クリア範囲 = Union(クリア範囲, r)
                End If
            End If
        Next r
        If Not クリア範囲 Is Nothing Then クリア範囲.ClearContents
'シート毎に"クリア範囲"をリセット
        Set クリア範囲 = Nothing
    Next s
End Sub

全シートで処理するならIn シート名In Worksheetsに、In Worksheets(s)In sに変更すればOKです。変数“s”の宣言は変更しなくてもマクロは動きますが、As Worksheetの方がかっこいい正しいです。

このコード、別記事で使ったボツ案とベースは同じです。別記事でボツにした理由は処理速度ですが、今回もこれより早い処理がないか考えてみました。

非ロックセルを配列に入れてみた

結論から書くと、1,048,576個の非ロックセルを処理するのに0.5秒程度しか早くなりませんでした。コードも読みにくいので前項のコードがおすすめです。

私のつたない知識では、「処理速度を上げる=配列」みたいな思考になりがちです。今回も多分に漏れず、とりあえず非ロックセルを配列に格納してみました。

要素数の決まっていない配列を一つずつ拡張していく処理はこのサイトのコードがおすすめです。似たようなサンプルはググれば結構な数ヒットしますが、個人的にこのコードが美しすぎでした。

    Dim 非ロックセル() As Range, クリア範囲 As Range, r As Range
    Dim i As Long
       
    ReDim 非ロックセル(0)
    
    For Each r In ActiveSheet.UsedRange
        If Not r.Locked Then
            Set 非ロックセル(UBound(非ロックセル)) = r
            ReDim Preserve 非ロックセル(UBound(非ロックセル) + 1)
        Else
            Exit Sub
        End If
    Next r
    ReDim Preserve 非ロックセル(UBound(非ロックセル) - 1)

で、意気揚々と非ロックセルを配列に入れていく訳ですが、「あれ?」となりました。配列に入れたところで、Unionメソッドに代わる処理が思い浮かびませんでした。そもそもUnionメソッドで結合しているから、ClearContetsプロパティが1回で済むわけです。これ以上早くできないような…

「ええい、ままよ!」と、せっせとこさえた配列をそのままUnionメソッドで結合、クリアしてみました。

Public Sub 非ロックセルのクリア_配列処理()
    Dim 非ロックセル() As Range, クリア範囲 As Range, r As Range
    Dim i As Long
       
    ReDim 非ロックセル(0)

    For Each r In ActiveSheet.UsedRange
        If Not r.Locked Then
            Set 非ロックセル(UBound(非ロックセル)) = r
            ReDim Preserve 非ロックセル(UBound(非ロックセル) + 1)
        End If
    Next r
On Error GoTo 該当なし
    ReDim Preserve 非ロックセル(UBound(非ロックセル) - 1)
    
    For i = 0 To UBound(非ロックセル)
        If クリア範囲 Is Nothing Then
            Set クリア範囲 = 非ロックセル(i)
        Else
            Set クリア範囲 = Union(クリア範囲, 非ロックセル(i))
        End If
    Next i
    If Not クリア範囲 Is Nothing Then クリア範囲.ClearContents
該当なし:
End Sub

このコードと前項のコードで、1,048,576個の非ロックセルの処理を比較したところ、10回の計測で平均0.5秒早くなりました(有意差あります)。ActiveSheet.UsedRangeからUnionするより配列からUnionする方が早いってことでしょうか?この辺はメモリの参照が理解できていないとダメ(勝手な想像)っぽいので、結果だけ覚えておくことにしました。

私の環境ではこの0.5秒、全く役に立たないので前項のコードを使っています。ただの配列コードのステマでした(美しい)。

よかったらブックマークとシェアをお願いします。最後までご高覧いただきありがとうございました。

よかったらシェアしてください
URLをコピーする
URLをコピーしました!
目次へ
トップへ
目次
閉じる