ラインの挿入や削除を監視し、特定行に対して操作が行われたときには操作をキャンセルしてもとに戻すサンプル。
→ 別バージョンを GitHub 上で公開中(ExcelRowProtection)。
Last active
June 16, 2022 22:58
-
-
Save furyutei/b31b738c0b9780a075f573eff5cef20e to your computer and use it in GitHub Desktop.
Excelで特定行の挿入や削除を抑制する試み
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
' ■ 行挿入/削除監視用クラス | |
' ◆ 定数・変数定義 { | |
Private Const MarkString = "mark" ' 挿入禁止行の直上のセルに入れる文字列 | |
Private Const LockString = "lock" ' 挿入禁止行のセルに入れる文字列 | |
Private WatchWorksheet As Worksheet ' 監視シート | |
Private WatchColumnString As String ' 監視列名(行挿入禁止制御用) | |
Private BackupMarkedCellString As String ' 監視列変化検出用文字列 | |
' } | |
' ◆ プロシージャ { | |
Private Function GetMarkedCells() As Range | |
Application.EnableEvents = False | |
On Error Resume Next | |
Dim MarkedCells As Range: Set MarkedCells = WatchWorksheet.Range(WatchColumnString & ":" & WatchColumnString).SpecialCells(xlTextValues) | |
On Error GoTo 0 | |
Application.EnableEvents = True | |
Set GetMarkedCells = MarkedCells | |
End Function | |
Private Function GetMarkedCellString() As String | |
Dim MarkedCellString As String: MarkedCellString = "" | |
Dim MarkedCells As Range: Set MarkedCells = GetMarkedCells() | |
If MarkedCells Is Nothing Then GoTo ENDPOINT | |
Dim CurrentCell As Range | |
For Each CurrentCell In MarkedCells | |
MarkedCellString = MarkedCellString & CurrentCell.Value | |
Next | |
ENDPOINT: | |
If MarkedCellString = "" Then | |
' 監視列が空のままだとパフォーマンスが低下するため、1行目に MarkString をセットしておく | |
WatchWorksheet.Range(WatchColumnString & "1").Value = MarkString | |
MarkedCellString = MarkString | |
End If | |
GetMarkedCellString = MarkedCellString | |
End Function | |
Public Sub Init(ColumnString As String, Optional TargetSheet As Worksheet) | |
Set WatchWorksheet = IIf(TargetSheet Is Nothing, ActiveSheet, TargetSheet) | |
WatchColumnString = ColumnString | |
End Sub | |
Public Sub UpdateMarkedCellString() | |
If BackupMarkedCellString <> "" Then Exit Sub | |
BackupMarkedCellString = GetMarkedCellString() | |
End Sub | |
Public Function ProtectLineInsert(ByRef TargetRange As Range) As Boolean | |
ProtectLineInsert = False | |
If TargetRange.Columns.Count = 1 And TargetRange.Column = WatchWorksheet.Range(WatchColumnString & "1").Column Then | |
' 監視列のみの編集であれば可能とする | |
BackupMarkedCellString = GetMarkedCellString() | |
Exit Function | |
End If | |
If BackupMarkedCellString = "" Then Exit Function | |
' 監視列の書き変えチェック | |
If BackupMarkedCellString <> GetMarkedCellString() Then | |
' 監視列の MarkString / LockString の個数が違っていたら Undo | |
GoTo UNDO_CHANGE | |
End If | |
Dim MarkedCells As Range: Set MarkedCells = GetMarkedCells() | |
If MarkedCells Is Nothing Then Exit Function | |
' 監視列中の文字を含むセルを順次チェック | |
Dim CurrentCell As Range | |
For Each CurrentCell In MarkedCells | |
With CurrentCell | |
If .Value = LockString Then | |
If 1 < .Row Then | |
' LockString の入ったセルの直上セルが空欄になってしまっていれば Undo | |
If .Offset(-1, 0).Value = "" Then GoTo UNDO_CHANGE | |
End If | |
End If | |
End With | |
Next | |
Exit Function | |
UNDO_CHANGE: | |
Application.EnableEvents = False | |
Application.Undo | |
Application.EnableEvents = True | |
ProtectLineInsert = True ' Undo された場合、True を返す | |
End Function | |
' } | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
' ◆ ライン挿入/削除監視オブジェクト用定義 { | |
Private Const TargetColumnString = "O" ' 監視列名(行挿入禁止制御用) | |
' } | |
' ◆ ライン挿入/削除監視オブジェクト取得用プロシージャ { | |
Private ProtectLineObject As clsProtectLineInsert | |
Private Function GetProtectLineObject() As clsProtectLineInsert | |
If ProtectLineObject Is Nothing Then | |
Set ProtectLineObject = New clsProtectLineInsert | |
Call ProtectLineObject.Init(TargetColumnString, Me) | |
End If | |
Set GetProtectLineObject = ProtectLineObject | |
End Function | |
'} | |
' ◆ イベントプロシージャ { | |
Private Sub Worksheet_Activate() | |
Call GetProtectLineObject().UpdateMarkedCellString | |
End Sub | |
Private Sub Worksheet_SelectionChange(ByVal Target As Range) | |
Call GetProtectLineObject().UpdateMarkedCellString | |
End Sub | |
Private Sub Worksheet_Change(ByVal Target As Range) | |
Dim IsUndone As Boolean: IsUndone = GetProtectLineObject().ProtectLineInsert(Target) | |
End Sub | |
' } | |
■使い方
- クラス モジュール clsProtectLineInsert を作成し、clsProtectLineInsert.vba の内容を貼付
- 対象シート上に監視用の列を用意(サンプルソースsample-Sheet.vbaでは O 列を想定)
- 対象シートのオブジェクト(モジュール)にサンプルソースsample-Sheet.vbaを貼り付けて、TargetColumnStringを2.に応じて書換
- 監視用列のロック(挿入/削除を禁止)したい行のセルに "lock"を、"lock" セルの直上のセルに "mark" を入力(縦に連続した"lock"セルがある場合、一番上のセルの直上にだけ"mark"を入れること)
例1:O9に"mark"、O10とO11に"lock"を入れると、10・11行目が行挿入/削除不可になる
※この場合、1〜9行目と12行目以降については挿入可能(1〜8行目と12行目以降は削除も可能)。
このため、1〜9行目に対して行の挿入や削除操作を行うと、"mark"/"lock"の行もずれていくことに注意
例2:O1に"lock"を入れると、1行目が行挿入/削除不可になる(この場合のみ、"mark"の入力は不要)
※たとえば1〜5行目を挿入/削除不可としたい場合には、O1〜O5に"lock"と入れればよい
- 必要に応じて、監視用列を非表示化
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
■使い方- 監視用の列を用意(サンプルソースは O 列想定)
- 対象シートオブジェクト(モジュール)にサンプルソース(ProtectLineInsert.vba)を貼り付け & TargetColumnStringを 1. に応じて書換
- 監視用列のロックしたい行のセルに "lock"、(連続した)"lock" の直上のセルに "mark" と入れる(例:O9に"mark"、O10とO11に"lock"を入れると、10・11行が行挿入不可になる)
新しい使い方を参照のこと。