Lockedについて

いつもお世話になっております。
下記のコードで
Cells(.Row, "C").Locked = True　必要なら
対象のセルをロックしたいのですが、
可能でしょうか。


Private Sub Worksheet_Change(ByVal Target As Range)
Dim st As String, Cnt As Long
With Target
st = .Address(False, False)
st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1))

Select Case st
Case "C"

If .Value = "必要" Then
Cells(.Row, "D").Resize(, 2).Interior.ColorIndex = 3
Cells(.Row, "C").Locked = True

ElseIf .Value = "不要" Then
Cells(.Row, "F").Resize(, 4).Interior.ColorIndex = 3
ElseIf .Value = "" Then
Cells(.Row, "D").Resize(, 6).Interior.ColorIndex = xlColorIndexNone
Else
Cells(.Row, "D").Resize(, 6).Interior.ColorIndex = xlColorIndexNone
End If

End Select

End With
End Sub

質問者からの補足コメント

• ここの部分ですが、
  ＞st = .Address(False, False)
  ＞st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1))
  わすれないようにいつもかいています>
  すみませんです。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/04/02 21:04

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2021/04/02 22:47

#4です。

目的が"必要"と入力された（D列セル背景が赤にされた）後、入力されないようにするのであれば、こんな方法もあります。

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Intersect(.Cells, Range("C:C")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If .Offset(, 1).Interior.ColorIndex = 3 Then
MsgBox ("変更できません")
Application.Undo
GoTo myEnd
End If
.Offset(, 1).Resize(, 6).Interior.ColorIndex = xlColorIndexNone
Select Case .Value
Case "必要"
.Offset(, 1).Resize(, 2).Interior.ColorIndex = 3
.Locked = True
Case "不要"
.Offset(, 3).Resize(, 4).Interior.ColorIndex = 3
End Select
myEnd:
Application.EnableEvents = True
End With
End Sub

この回答へのお礼

ご返事遅れてすみません。
いろいろ難しいですところ
ありがとうございました。

お礼日時：2021/04/03 19:03

No.4 回答者： Qchan1962 回答日時： 2021/04/02 22:26

こんばんは、横から失礼します。

＞対象のセルをロックしたいのですが、可能でしょうか。
これについては、既に回答がありますが、
＞.Locked = True　の使用目的がイマイチわかりません。
どのタイミングで保護をかけるのでしょうか、、"必要"と入力した場合に変更できないようにするのが目的でしょうか
初めにすべてのセルのロックを解除しておいてシート保護をかけるのだと思いますが、書式設定を許可しておかないと
.Interior.ColorIndex =　はエラーになりますね。

また、
Select Case　を使用していてIFをさらに入れていると言う事は、例えば
Case "G"　なども追加されると言う事なのでしょうか

抜粋（サンプル）コードでSelect Case、、、IF、、IFとなっているのかも知れませんが、
いずれにしても、Targetがあるので私的には、活用された方が良いのでは無いかと思います。
ちなみに　"必要"　で変更できないようにするのなら関係ないかも知れませんが、"不要"　のち　"必要"　（又は逆）とした場合、D～I列まで赤くなるのでは無いかと思います。なので、一旦
.Resize(1, 6).Interior.ColorIndex = xlColorIndexNone
を実行して　Case "必要"　又は　Case "不要"　を実行すれば良いように思います。

示されているコードは、この様な感じでも同じ処理になるかと、、、
（少し変えてしまいました）


Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Intersect(.Cells, Range("C:C")) Is Nothing Then Exit Sub
Application.EnableEvents = False
.Offset(, 1).Resize(, 6).Interior.ColorIndex = xlColorIndexNone
Select Case .Value
Case "必要"
.Offset(, 1).Resize(, 2).Interior.ColorIndex = 3
.Locked = True　　’？
Case "不要"
.Offset(, 3).Resize(, 4).Interior.ColorIndex = 3
End Select
Application.EnableEvents = True
End With
End Sub


余計なお世話ですが、Worksheet_Changeの場合、セルをフィルした時などスタックする可能性がありますので、Application.EnableEventsは入れておいたほうが良いと思います。

この回答へのお礼

ありがとうございます。
Worksheet_Changeって
やっばり
やっぱりコツをつかむまで、時間がかかりそうです
ありがとうございます。
必要と入力されたら、そのセルだけをLocked
する
これは難しいです

お礼日時：2021/04/02 22:32

No.3 回答者： めぐみん_ 回答日時： 2021/04/02 21:10

補足を見て。

それであれば

'st = .Address(False, False) 'こちらはコメントアウトしておくとか？
st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1))

それに忘れないようにって点ではテキストファイルなどでコードを保存し、必要に応じて部分コピペをする私みたいな方法は如何でしょう？

この回答へのお礼

ありがとうございます。
そうします。

お礼日時：2021/04/02 21:18

No.2 回答者： めぐみん_ 回答日時： 2021/04/02 20:19

＞st = .Address(False, False)

＞st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1))

ここについてですが参考コード。

Dim r As Range
Dim st As String
For Each r In Range("A1,C1,AC1,CA1")
st = Left(Split(r.Address, "$")(1), 1) ' (0) は $ に左の "" 文字になるので
Debug.Print r.Address, st
Next

結果：
$A$1 A
$C$1 C
$AC$1 A
$CA$1 C

絶対参照の"$"で区切るのをりようするとか。

あとSelect Case につてはIf文でIntersectを使い変数stをやめて

With Target

If Not Intersect(.Cells, Range("C:C")) Is Nothing Then

とかもあるかと。

No.1 回答者： めぐみん_ 回答日時： 2021/04/02 19:48

https://www.osiete-excelvba.work/entry/2019/11/0 …

『おわりに』を参照願います。

～セルの設定又は設定解除を実行した後にシートを保護する事で、初めてセルの変更可否が有効となります～　抜粋。

この回答へのお礼

ありがとうございます。

お礼日時：2021/04/03 19:03