[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『データ入力後に特定のセルをロックするマクロ』（お正月）
お尋ねします。
以下のコードは、ネットから参照(https://ja.extendoffice.com/documents/excel/3778-excel-lock-cell-after-data-entry-input.html)したものです。
「Excelでのデータ入力または入力後にセルをロックまたは保護するにはどうすればよいですか？」というもので設定したのですが、
特定のセル=B12:B2011にリストで選択して入力すると、そのセルにロックをかけたいのですが、入力してもロックはかからず、入力したデータを消すとそこで初めてロックがかかってくれます。
これを入力した時点でロックがかかるようにするには、どのように修正したらよいでしょうか？
どうかよろしくお願いいたします。
Dim mRg As Range
Dim mStr As String
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("B12:B2011"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="12345"
If xRg.Value <> mStr Then xRg.Locked = True
Target.Worksheet.Protect Password:="12345"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
Dim mRg As Range
Dim mStr As String
'-----------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
'-----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("B12:B2011"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="12345"
If xRg.Value <> mStr Then xRg.Locked = True '←ココに注目
Target.Worksheet.Protect Password:="12345"
End Sub
'----------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
ちなみに仰ること"だけ”実現するなら、もっとシンプルに出来ますよ。
(1) ブックを開いたときに、１回だけシートの保護を解除してから、ユーザーの操作のみ保護の対象にしなおす。 (2) そのシートでセルの値が書き換えられたら、該当セルをロック状態にする
↑の２点だけ考えればよいので・・・
（もこな２） 2021/03/03(水) 19:58
＞1.最初にこの範囲のロックを解除し、セルを選択して右クリックしてから、 ・・・
最初に書かれている準備を済ませてから、コードを貼り付けましたか？
（半平太） 2021/03/03(水) 20:17
半平太さん、１の説明どおり、範囲指定して保護のチェックを外しているのですが。。。
（お正月） 2021/03/03(水) 20:45
＞そのセルにロックをかけたいのですが、入力してもロックはかからず、 ＞入力したデータを消すとそこで初めてロックがかかってくれます。
何か変だなと思いながら、そこを簡単に読み飛ばしてしまった。
＞1.最初にこの範囲のロックを解除し、セルを選択して右クリックしてから、 ・・・下のマクロを実行してから、 ↑ 試しに上の準備はやらないで、代わりに下記マクロを実行してから、テストしてみてください。
Sub init()
Me.Unprotect Password:="12345"
Range("B12:B2011").Locked = True
Range("B12:B2011").SpecialCells(xlCellTypeBlanks).Locked = False
Me.Protect Password:="12345"
End Sub
（半平太） 2021/03/03(水) 22:37
＞もこな２さん、ココに注目部分の意味は、データが入力されたらロックするということでしょうか？
注目としたのは【どのような条件で】ロックするか判定している部分です。
＞現状は逆の動きをしているように思いますが。。。
なんの逆だと言っているは理解しかねますが、逆ならさらにその逆にすればよろしいのでは？
ちなみに私ならこんな感じにします。
（理解していただきたいので、何も考えずにコピペして完成というのはNGとします）
【ThisWorkbookモジュール】
Private Sub Workbook_Open()
With Worksheets("Sheet1")
.Unprotect Password:="12345"
.Protect UserInterfaceOnly:=True, Password:="12345"
End With
End Sub
【Sheet1のモジュール】
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, MyRNG As Range
Set xRg = Intersect(Range("B12:B2011"), Target)
If Not xRg Is Nothing Then
For Each MyRNG In xRg
If MyRNG.Value <> "" Then
MyRNG.Locked = True 'セルの値が""以外ならロックする
Else
MyRNG.Locked = False 'セルの値が""ならロックを解除する（BeforeDoubleClickイベントでセルの値がクリアされるとこれが作動）
End If
Next MyRNG
End If
End Sub
'-----------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'▼B12〜B2011でダブルクリックをしたときはそのセルの値をクリアする
' （UserInterfaceOnly:=True で保護した場合、ロックされているセルであってもマクロからであれば操作可能）
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Cancel = True
Target.ClearContents
End If
End Sub
（もこな２ ） 2021/03/03(水) 23:41
＞もともとのコードを消して置き換えるのでしょうか？
元のコードは消す必要ないです。
シートモジュールに追加で貼り付けて、1回だけ実行です。 (準備作業の代わりとなるものです）
（半平太） 2021/03/04(木) 09:54
ちょっと分からないです。
＞対象セルにリストから選択してもロックはかからず、 リストから選択できたんですね。 それは当然ですよね。じゃないと、何も入力出来ないので。。
選択できた段階で(＝データが入力できた段階で）、ロックが掛かるハズです。
そこで、もしロックが掛かってなければ、別のデータを入れられることになりますが、 その現象が生じていると言うことなんですか？
＞それを消すとそこでロックがかかります。 消すとはどう言うことを意図しているのですか？ 上の流れからすると、消すことも出来ないハズですが、消すことまでは出来てしまったんですか？
（半平太） 2021/03/04(木) 17:54
(1)B13セルを選択した時点で、SelectionChangeイベントが発生して【mStr】に「""」が格納される (2)B13セルの値を変えたことによりChangeイベントが発生して【mStr】に格納されている「""」とB13セルの値を比較 → 異なっているからロックする
という流れになってるのは直ぐに理解できると思います。
で、提示のものをこちらで試すとロックがちゃんとかかる（入力規則のリストは出てくるものの選択して値を書き換えようとするとはじかれる）ので、何か説明してないことが他にあったりしませんかね。
（例えば入力規則が設定されている（値が書き換えられている）のはA列でB列にはVlookup関数で表示させてるだけとか・・）
（もこな２ ） 2021/03/04(木) 18:53
お二人からの質問にご返事させていただきます。
半平太さんへ
選択できた段階で(＝データが入力できた段階で）、ロックが掛かるハズです。 選択出来た段階でロックが掛からないのです。
そこで、もしロックが掛かってなければ、別のデータを入れられることになりますが、
その現象が生じていると言うことなんですか？ はい、そのとおりです。
消すとはどう言うことを意図しているのですか？ リストから選択してデータをDeleteキーで消すということです。
上の流れからすると、消すことも出来ないハズですが、消すことまでは出来てしまったんですか？ はい。消すことができます。消すとロックがそこではじめて掛かります。
もこな２さんへ
多分B列には【入力規則】のリストが設定されているんですよね。 はい。リストとは言っても「許可」という文字列一つだけです。
〜流れになってるのは直ぐに理解できると思います。 すみません。よくは理解できていません。
何か説明してないことが他にあったりしませんかね。 いいえ、単純に入力規則のリスト一つだけで、関数など設定していません。B列の許可を選択することで、C列に日付が入るようにはしています。
補足説明です。
理想としましては、B列に許可という文字をセルにリストで入力することで、C列にいわゆる許可の日付が入るという形にしたいのです。つまり、このB列は上司だけが扱うセルにしたいので、本当は、リストを選択する時点でロックを掛けておいて、セルをクリックすることで、解除パスワードが要求されて、そのパスワードを入力したら、リストが選択可能になり、セルに許可が入力されると再びロックが掛かるという流れに出来たらといのうが理想です。要は、部下にこのB列を扱わせないようにしたいのです。シートのパスワードではなく、セル(B列)のみにパスワードをかけるようにできないでしょうか？もちろん、シート自体にも保護はかけています。必要な箇所のみを入力させるようにしたいので。
説明がきちんと出来ておらず、すみません。
今一度、半平太さん、もこな２さん、どうぞよろしくお願いいたします。
（お正月） 2021/03/04(木) 19:53
こちらでは、当該現象が再現しないですねぇ。
これ以上考えられないので、私は降ります。 m(__)m
（半平太） 2021/03/04(木) 20:31
■２
＞すみません。よくは理解できていません。
うーん。どこらへんが理解できないですか？
ブレークポイントを設定してステップ実行すれば、どの操作で何が実行されているか丸わかりだとおもうんですけど・・・・
■３
多分B列には【入力規則】のリストが設定されているんですよね。
↑あってますか？
■４
「■３」が合ってるとして、リストを選択した"後"にChangeイベント発生してますか？
■５
「■４」の答えがYESだとして、「If xRg.Value <> mStr」の判定が真となっていて「xRg.Locked = True」が実行されてますか？
■６
2021/03/03(水) 23:41 に提示したものは試してみましたか？
試したなら結果を教えてください。
（もこな２ ） 2021/03/05(金) 00:05
Dim mRg As Range
Dim mStr As String
'-----------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
Debug.Print "「mRg」に【" & mRg.Address(0, 0) & "】を格納した"
mStr = mRg.Value
Debug.Print "「mStr」に【" & mStr & "】を格納した" & vbLf
End If
End Sub
'-----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address(0, 0) & " の書き換えによりChangeイベントが発生した"
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("B12:B2011"), Target)
If xRg Is Nothing Then
Debug.Print "範囲外のため処理を中止した"
Exit Sub
Else
Debug.Print xRg.Address(0, 0) & " の処理を開始する"
Target.Worksheet.Unprotect
Debug.Print "【" & xRg.Value & "】と【" & mStr & "】を比較"
If xRg.Value <> mStr Then
Debug.Print "判定結果は「真」→" & xRg.Address(0, 0) & "のロックを実行する"
xRg.Locked = True
Else
Debug.Print "判定結果は「偽」→ロックはしない"
End If
Target.Worksheet.Protect
End If
Debug.Print "Changeイベントの処理が完了した" & vbLf & vbLf
End Sub
'----------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
Debug.Print "「mRg」に【" & mRg.Address(0, 0) & "】を格納した"
mStr = mRg.Value
Debug.Print "「mStr」に【" & mStr & "】を格納した" & vbLf
End If
End Sub
（もこな２ ） 2021/03/05(金) 00:35
■１
＞断言しませんが多分できません。
はい、わかりました。
■２
＞うーん。どこらへんが理解できないですか？
ブレークポイントを設定してステップ実行すれば、どの操作で何が実行されているか丸わかりだとおもうんですけど・・・・
少しわかってきました。勉強します。
■３
＞多分B列には【入力規則】のリストが設定されているんですよね。
↑あってますか？
はい、そのとおりです。
■４
＞「■３」が合ってるとして、リストを選択した"後"にChangeイベント発生してますか？
発生していないと思います。
■５
＞「■４」の答えがYESだとして、「If xRg.Value <> mStr」の判定が真となっていて「xRg.Locked = True」が実行されてますか？
「■４」はNOです。
■６
＞2021/03/03(水) 23:41 に提示したものは試してみましたか？
試したなら結果を教えてください。
（もこな２ ） 2021/03/05(金) 00:05
以下のエラーとなります。
実行時エラー1004 RangeクラスのLockedプロパティを設定できません。
MyRNG.Locked = True 'セルの値が""以外ならロックする
■７
＞以下にそっくり入れ替えてから操作すると、イミディエイトになんと出力されますか？
Dim mRg As Range
すみません。イミディエイトの出力はどこを確認すればよいのかわかりません。
もこな２さんがお示しいただいたこのマクロを試したところ、リストを選択したらロックが掛かりました。ただ、シート自体にはロックをかけない状態で、Bセルの書式設定の保護のチェックを入れておくことが条件ですよね。
私の希望は、もともとシートにはパスワード設定(12345)してロックをかけておき、リストが入っているB列は、保護のチェックを外しておき、リスト選択後にロックをかけたいのです。
（お正月） 2021/03/05(金) 07:33
■９
＞実行時エラー1004
説明してなかったですが、一旦ブックを開きなおしてくださいね。
（それか「Workbook_Open」を手動で実行してください）
それでも発生してしまいますか？
■10
＞イミディエイトの出力はどこを確認すればよいのかわかりません。
↓を読んでみてください
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
■11
＞シート自体にはロックをかけない状態で、Bセルの書式設定の保護のチェックを入れておくことが条件ですよね。
＞私の希望は、もともとシートにはパスワード設定(12345)
違います。じっくり読めばわかりますが提示されたものとおなじです。（イミディエイトへの出力を足しただけ）
パスワードはテストするときに邪魔くさいので取ってるだけです。いまそこは問題ではありません。
（もこな２ ） 2021/03/05(金) 07:46
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010 https://kabu-macro.com/detail.php?dir=word&dir2=ha-ho&uri=breakpoint
■６の補足
言わなくてもわかるとはおもいますが、シート名は適宜ご自身の環境に合わせて変えてくださいね。
With Worksheets("Sheet1") ←ココ
■11の補足
＞シート自体にはロックをかけない状態で、Bセルの書式設定の保護のチェックを入れておくことが条件ですよね。
ちょっと混乱されているようですが、元のコードも
1. 対象セルの【ロック】のチェックを外しておく 2. シートの【保護】をしておく
という設計になっていますよね。
（もこな２ ） 2021/03/05(金) 08:20
（もこな２） 2021/03/05(金) 13:00
Dim mRg As Range
Dim mStr As String
'-----------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
Debug.Print "「mRg」に【" & mRg.Address(0, 0) & "】を格納した"
mStr = mRg.Value
Debug.Print "「mStr」に【" & mStr & "】を格納した" & vbLf
End If
End Sub
'-----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address(0, 0) & " の書き換えによりChangeイベントが発生した"
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("B12:B2011"), Target)
If xRg Is Nothing Then
Debug.Print "範囲外のため処理を中止した"
Exit Sub
Else
Debug.Print xRg.MergeArea.Address(0, 0) & " の処理を開始する"
Target.Worksheet.Unprotect
Debug.Print "【" & xRg.MergeArea.Cells(1, 1).Value & "】と【" & mStr & "】を比較"
If xRg.MergeArea.Cells(1, 1).Value <> mStr Then
Debug.Print "判定結果は「真」→" & xRg.MergeArea.Address(0, 0) & "のロックを実行する"
xRg.MergeArea.Locked = True
Else
Debug.Print "判定結果は「偽」→ロックはしない"
End If
Target.Worksheet.Protect
End If
Debug.Print "Changeイベントの処理が完了した" & vbLf & vbLf
End Sub
'----------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B12:B2011"), Target) Is Nothing Then
Set mRg = Target.Item(1)
Debug.Print "「mRg」に【" & mRg.Address(0, 0) & "】を格納した"
mStr = mRg.Value
Debug.Print "「mStr」に【" & mStr & "】を格納した" & vbLf
End If
End Sub
（もこな２） 2021/03/05(金) 16:38
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.