特定の行に値が入力（消去）されたら隣の複数のセルをロック（ロック解除）を繰り返す

特定の行に値が入力（消去）されたら隣の複数のセルをロック（ロック解除）する。
VBA初心者です。仕事で使うものですが、長期間うまく出来ず困っています。すみませんが、ご教授ください。
Excel2013のVBAで作っています。できれば、1つのシートで作りたいです。
業務担当者が入れたデータ（C3:F3）に対し、責任者が許可した場合、
空白になっている指定の列（A列）に許可した旨を入力します。
指定の列（A列）はユーザーネームで認識させていてプルダウンで選択し
責任者しか値が出ないようにしています。
責任者が許可したデータ=指定の列（A列）に値を入力したデータは、
業務担当者が編集できないように指定の範囲内のセルロック（C3：F3）したいです。
責任者が許可を取り消したら=指定の列（A列）の値を消去したデータは、
隣のセルの範囲内のセルロック（C3：F3）も外したいです。
これが1行だけなら出来るのですが、これが下にずっと続いていきます。
責任者の許可も外したり、許可したりを繰り返します。
指定の列（A列）は「許可」＝値を入力した
「空白（未許可）」が飛び飛びで続きます。
ロックしたセル以外のセルは日々データを追加したり、
責任者が指定の列（A列）を「許可」するまでは業務担当者が編集したりしたいです。

該当のソースコード

Excel　VBA
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("B3").Value<>""Then
Range("C4:F22").Locked=Flase
ActiveSheet.Protect
ElseIf Range("B3").Value=""Then
ActiveSheet.Unprotect
End If
End Sub

試したこと

For~loopで行うべきかとやってみましたが、うまくいきません。
A列にフィルターをかけてからロックするべきか、
指定の列（A列）に（「許可」＝値が入力されている）ものは隣のセル（保護したいセル）に色付けし
色がついているところだけロックするべきなのか、
色々試しているのですがVBAスキルがなくどれもうまくいかずにいます。

補足情報（FW/ツールのバージョンなど）

Excel_2013

行動規範の内容に同意します

回答4件

・A列には権限のある人だけが入力可能となっている
というところはできているという前提で、「行単位のロック制御」の部分に絞ってアドバイスさせていただきます。

提示いただいたコードを見ると、
・処理するのはWorksheetChangeイベント
・ロック制御の判断はB3セルで行っている
・B3セルが空でない時、セル範囲C4:F22をロック解除し、シートを保護する
・B3セルが空の時、シートの保護を解除する
という動きになっているようです。

これを踏まえて、現状の問題点やポイントを整理してみます。

①行単位に制御できていない

まずB3セルの値だけでC4:F22のロックを一括で制御していますので、行単位でのロック制御ができていません。
行単位のロック制御といっても、
「A列に変更のあった行に対してのみロック状態を制御する」という方法や、
「A列のどこかに変更があった場合、対象範囲の全行のロック状態を制御しなおす」といった方法が考えられます。

前者の場合、「A列に変更のあった行」を取得してその行に対してだけロック制御を行います。
後者の場合、「A列に変更のあった行」がどの行かを知る必要はありませんが、どの行を変更したとしてもすべての行を判断しなおすことになります。

いずれにしてもA3セルの状態に対してはC3:F3のみロック制御、といったように行単位で処理する必要があります。

②セルのロックとシートの保護

現状ではB3セルの状態でシートを保護するか保護解除するかを判断していますが、セルのロックプロパティはシートが保護されている時にしか効果を発揮しません。
行単位のロック制御が実現できた場合、例えば１行目はロック、２行目はロック解除という状態になったりしますが、シートが保護されていなければ１行目のロックも効かなくなります。

このため、行単位にロック制御をしたいのであればシートは常に保護しておくことになると思います。
⇒すべてのセルがロック解除されている場合は保護をかけなくてもいいのですが、そこまで判断するコードを書くかどうかですね。

③チェック対象外のセルでも動作してしまう

WorksheetChangeイベントは、そのシート上でセルの値が変更された時に動作します。
具体的には「セルに値を入力した」「セルの値を消した」「コピペした」などで動作するのはもちろんのこと、「セルが編集状態に入った」だけでも発生します。
⇒例えばセルにカーソルがある状態でF2キーを押すとセルの編集モードになりますが、そのまま値を変えずTabキーで隣のセルに移動したとしてもWorksheetChangeイベントが発生します。

さらに、シート内のどのセルの変更であってもWorksheetChangeイベントが発生します。
今回はA列の変更だけ監視できればいいのですが、関係ないZ列で値を変更した場合にもWorksheetChangeイベントは発生します。

このイベントは上記のとおり非常に高い頻度で発生しますので、対象外のセルの場合はすぐに処理を抜けるよう考慮してあげないと必要以上に負荷がかかってしまうことになりますのでご注意ください。

④複数セルがまとめて変更されることもある

Excelでは複数のセルを同時に範囲選択し、一度に値を変更することが可能です。
例えば「３行まとめてコピペした」とか「A列全体を選択してDELキーでクリアした」などです。

この場合、WorksheetChangeイベントに渡されるTarget変数には、複数のセルを持ったRange型が渡されてきます。

変更されたセルの中にチェック対象のセルが含まれているかを確認し、含まれている場合はそれらのセルそれぞれに対してチェックを行う必要があります。

この「含まれているか？」の判断には、セル範囲の重なりを抽出するIntersect関数が利用できます。
例えばA5:C7,A10,B12,A20を含むTarget変数に対して
Set rng = Intersect(Target,Range("A1:A15"))
という処理を行うと、rng変数にはA5,A6,A7,A10のセル範囲だけが抽出されます。

対象セルが含まれない場合はNothingが返されますので、その場合今回は処理を抜けてしまえばいいでしょう。

サンプルコード

以上を考慮したサンプルコードです。
チェック範囲はA3:A100としており、これに応じてC3:F100の範囲が行単位でロック制御されます。
B列にはロック状態を表示しています。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rng As Range    '変更されたセル範囲(A列のみ抽出したもの)
    Dim cellA As Range  '変更されたセル(rng変数より１セルずつ取り出す)
    Dim cellB As Range  'CellAの１つ右隣のセル(B列)
    Dim rngCF As Range  'CellAの２～５つ右のセル範囲(C～F列)
    
    '変更のあったセル(Target)の中で、チェック対象範囲(A3:A100)に含まれるセルを抽出する
    Set rng = Intersect(Target, Range("A3:A100"))
    
    If rng Is Nothing Then
        'チェック対象範囲に変更がなければ処理を抜ける
        Exit Sub
    Else
        'チェック対象範囲に含まれるセルが１つでもあればロック制御を行う
        
        'シート保護解除
        Me.Unprotect        '←ここでのMeは、このマクロを記述しているシートを指しています
        
        'チェック対象範囲で抽出したセル(変更のあったA列のセル)を１つずつ取り出すループ処理
        For Each cellA In rng
            
            'B列：セルAより「１つ右のセル」
            Set cellB = cellA.Offset(0, 1)
            'C～F列：セルAより「２つ右のセル」～「５つ右のセル」
            Set rngCF = Range(cellA.Offset(0, 2), cellA.Offset(0, 5))
            
            'セルAが空欄なら未承認、それ以外は承認済み
            If cellA.Value = "" Then
                '未承認ならセルは変更可能
                cellB.Value = "Unlock"
                rngCF.Locked = False
            Else
                '承認済みならセルをロック
                cellB.Value = "Lock"
                rngCF.Locked = True
            End If
        Next
        
        'シート保護
        Me.Protect
    End If
    
End Sub

上記は「A列に変更のあった行に対してロック状態を制御」するサンプルです。
「A列のどこかに変更があった場合、全行のロック状態を制御する」のであればFor Eachで対象セルを抽出してループする必要はないですが、かわりに対象範囲の全行をループ処理する必要があります。

長くなってしまいましたが、参考になれば幸いです。

投稿2019/02/22 02:03

編集2019/02/22 04:08

jawa

総合スコア3013

green88008800

2019/02/22 03:44

回答頂きありがとうございます。勉強になります。どのコードを使うべきかどこを直せばいいのか混乱していました。 'C～F列：セルAより「２つ右のセル」～「５つ右のセル」 Set cellCF = Range(cellA.Offset(0, 2), cellA.Offset(0, 5))の所で｢変数が宣言されていません｣というエラーがでます。｢cellCF｣の所がマーキングされているのですが、｢rngCF｣に変更で合ってますか？それとも新しく変数を宣言しなければならないですか？

jawa

2019/02/22 04:04 編集

失礼しました。単一セルではなくセル範囲を指すものだったので、変数の名前をcellCF⇒rngCFに変更していました。 rngCFに読み替えてご利用ください。

green88008800

2019/02/22 11:32

jawaさん、無事会社で作成できました。回答いただきありがとうございました。コードを分かりやすく解説していただき大変勉強になりました。本当にありがとうございました。感謝しています。

行動規範の内容に同意します

ベストアンサー

A列に責任者の名前が入るとB列に処理日(承認日)が記録されC列からF列のセルにロックがかかります。
責任者の名前が削除されると処理日も削除されます。
連続したセル範囲を選択してコピー貼付けをしても、あるいは削除しても同じ動作をします。

ただし離れたセル範囲、例えば　A1とA3とA10:A15をコントロールキーを押して一度に選択してコピー貼付けや削除をすると、処理せずメッセージボックスが出て未処理を伝えます。

【要注意】
せっかくプルダウンリストを用意しても、名前をセルにキーボード入力する責任者がいるとします。
名前を打ち間違えると入力規則違反のメッセージが出ます。
この際、キャンセルしても未確定文字を消してもイベントマクロが動作します。
変更したい行への入力間違であれば正しく入力し直せばいいのですが、入力する行も間違っていたとします。
その行が以前、承認した行であった場合、処理日が今日に変更されてしまいます。

vba
1Private Sub Worksheet_Change(ByVal Target As Range)
2
3    If Target.Areas.Count > 1 Then
4        With Application
5            .EnableEvents = False
6            .Undo
7            .EnableEvents = True
8        End With
9
10        MsgBox _
11            "離れたセル範囲への入力 / 削除が行われため" & vbCrLf & _
12            "処理されませんでした。", vbCritical
13        End
14    End If
15
16    If Intersect(Target, Range("A:A")) Is Nothing Then
17        Exit Sub
18    Else
19        ActiveSheet.Unprotect
20
21        Select Case Target.Text
22        Case Is <> ""
23            Application.EnableEvents = False
24
25            Range(Target.Offset(, 2), Target.Offset(, 5)).Locked = True
26            Range(Target.Offset(, 1), Target.Offset(, 1)).Value = Date
27
28            Application.EnableEvents = True
29        Case ""
30            Application.EnableEvents = False
31
32            Range(Target.Offset(, 2), Target.Offset(, 5)).Locked = False
33            Range(Target.Offset(, 1), Target.Offset(, 1)).Value = ""
34
35            Application.EnableEvents = True
36        End Select
37
38        ActiveSheet.Protect
39    End If
40End Sub

投稿2019/02/22 04:01

編集2019/02/22 05:10

zbat

総合スコア52

green88008800

2019/02/22 11:28

zbatさん、回答いただきありがとうございました。無事、会社で作成出来ました。本当にありがとうございます。私の説明不足や知識不足で分かりづらい質問やコメントになり、すみませんでした。

行動規範の内容に同意します

IDはA列に、承認判定はB列に"許可"or""を入力する
また、Sheet(データ)のデータ範囲は100行と仮定してます。

変更して試してみて下さい。

For Each Target In Selection は範囲指定に書き換えました。
危ない不具合があると思うので。

vba
1
2' ThisWorkbook
3' 環境変数からユーザー名を取得して
4' 責任者ならA列B列のセルのロックを解除する
5' 担当者ならA列B列のセルをロックする
6' シートに保護をかけて処理を終了する
7Private Sub workbook_open()
8    Dim environmentString As String
9    Dim userName As String
10    Dim i As Long
11    
12    i = 1
13    Sheets("name").Unprotect
14    Sheets("データ").Unprotect
15    
16    Do
17        environmentString = Environ(i)
18        If Left(UCase(environmentString), 9) = "USERNAME=" Then
19            userName = Mid(environmentString, 10, Len(environmentString))
20            Sheets("name").Cells(100, 1).Value = userName
21            Exit Do
22        End If
23        i = i + 1
24    Loop Until Environ(i) = ""
25    
26    Dim findRng As Range
27    Set findRng = Sheets("name").Range("J100:J116").Find(userName, LookAt:=xlWhole)
28    
29    If findRng Is Nothing Then
30        Sheets("データ").Range("A:B").Locked = True
31    Else
32        Sheets("データ").Range("A:B").Locked = False
33    End If
34    
35    Sheets("name").Protect
36    Sheets("データ").Protect
37End Sub
38' ---------------------------------------------------------------------------------
39' Sheet(データ)
40' データ範囲はA1:F100までと仮設定してある
41Private Sub Worksheet_Change(ByVal Target As Range)
42    Dim Rng As Range
43    
44    Set Rng = Range("B1:B100")
45    
46    If Intersect(Target, Rng) Is Nothing Then
47        Exit Sub
48    Else
49        ActiveSheet.Unprotect
50
51        For Each Target In Rng
52            Select Case Target.Value
53            Case "許可"
54                Range(Cells(Target.Row, 3), Cells(Target.Row, 6)).Locked = True
55            Case ""
56                Range(Cells(Target.Row, 3), Cells(Target.Row, 6)).Locked = False
57            End Select
58        Next Target
59
60        ActiveSheet.Protect
61    End If
62End Sub
63

投稿2019/02/20 21:32

zbat

総合スコア52

zbat

2019/02/20 22:01

セルの色付けのことを書かれていたのでご存知だとは思いますが条件付き書式でデータ範囲を選択して式に =CELL("protect",A1)=1 を入力して書式で好きな色を指定するとセルのロックの変更が色で見てとれます。

行動規範の内容に同意します

入力データがC列からF列で、承認がA列ならこれでどうでしょうか？
試してみて下さい。

vba
1Private Sub Worksheet_Change(ByVal Target As Range)
2    If Intersect(Target, Range("A:A")) Is Nothing Then
3        Exit Sub
4    Else
5        ActiveSheet.Unprotect
6
7        For Each Target In Selection
8            Select Case Target.Value
9            Case "許可"
10                Range(Cells(Target.Row, 3), Cells(Target.Row, 6)).Locked = True
11            Case ""
12                Range(Cells(Target.Row, 3), Cells(Target.Row, 6)).Locked = False
13            End Select
14        Next Target
15
16        ActiveSheet.Protect
17    End If
18End Sub
19

投稿2019/02/19 16:26

zbat

総合スコア52

green88008800

2019/02/20 01:41

回答いただきありがとうございます。うまくいかない点があるのですみませんが教えてください。 A列のA3セルに｢承認｣と入ると、A列のその他のセル、例えばA7やA2のセルが編集不可になってしまい、｢保護されています｣と表示がでて、｢承認｣できなくなってしまいます。解決策はあるものでしょうか？　許可する責任者は数名おり、その人の氏名がA列に入ります。複数の氏名に対応させるには責任者氏名に特定の文字をつけたして｢like｣で適応させるべきですか？何度もすみません。

zbat

2019/02/20 03:03

> 指定の列（A列）はユーザーネームで認識させていてプルダウンで選択し責任者しか値が出ないようにしています。この”責任者しか値が出ない”が気になっていました。どう設定されていますか？サンプルのマクロは A列の値に変更があった時 A列の選択された範囲の値によって C列からF列のロックの変更をしているので A列は何もしていなはずなので。。。

green88008800

2019/02/20 05:49

説明不足で申し訳ありません。このファイルにはシートが3枚あります。｢name｣シート A100セルにログインID(数字) B100セルに数式｢IFERROR(VlOOK(A100,J100:K116,2,0),2,0),"")｣ J100 責任者ログインID 7人 K100 責任者氏名一覧　　7人 dataシート B2セルに数式｢IFERROR(VlOOKUP(name!$A100$,name!J:K,2,0),"")｣責任者がログインするとログインIDを認識し、責任者であればnameのB100に責任者氏名が出ます。dataのB2にも責任者氏名が入ります。反対に責任者以外がログインしたときは、氏名が出ず、データシートのA列のプルダウンにも氏名は出ません。責任者がログインしたときのみ責任者氏名が出るようにしてあります。データ　シート責任者と業務担当者が入力、許可するシートデータシートに回答していだだいたVBAコードを入れました。データシートのA列にデータの入力規則のリストで｢data!$B$2:$B$3｣データシートB2セルから名前を引っ張ってプルダウンで選択します。B3セルは空欄にしています。 VBA入力画面のthisworkbookに以下のコードを入力しています。 Private Sub workbook_open() Dim environmentString As String Dim i As Long i=1 Do environmentStringp=Environ(i) If Left(UCase(environmentString),9)="USERNAME"=Then Sheet("name").cells(100,1).Value=Mid(environmentString,10,Len(environmentString)) Exit Do End If i=i+1 Loop Unitil Environ(i)="" Sheet("name").Protect Passwordp:=パスワード　 End Sub 読みづらくてすみません。

zbat

2019/02/20 21:03

私は読み違えていたかもしれません。環境変数からユーザー名を取得してA列に入力規則でプルダウンということは承認、未承認の判定入力はB列になるのでしょうか？ Sheet(データ)は責任者、担当者のいずれが開いてもシートに保護がかかっているそうだと仮定してのサンプルを回答２に貼っておきますので確認してみて下さい。

green88008800

2019/02/21 03:58

回答ありがとうございます。 Excelブックを開くとシートの保護解除画面がでてパスワードを求められます。パスワードはかけてないはずなのでデバッグを押すと Sheets("name").Unprotect の所が黄色になっています。私説明が下手で本当にすみません。データシートのA列にはユーザーID認識し、責任者氏名をプルダウンで選択します。隣の列には許可した日付が入ります。A列に氏名が入ったら許可したとみなし、セルをロックしたいです。許可という言葉ではなく責任者氏名の入力をもって許可とみなすことになっています。nameシートは改ざんされないように非表示にしてパスワードかけようと思っています。その場合ThisBookのコードSheets("name").Protectのあとにパスワードを入力すればいいですか？

green88008800

2019/02/21 05:29

先ほどのパスワード求められるエラーは新規ブックで作成し直したら直りました。担当者がログインするとうまくいきます。責任者氏名と許可が入ればデータシートA列、B列は許可したデータだけロックされます。責任者がログインした時がうまくいかなくて、データシートのA列B列がロックされてしまい、例えばA3に許可=責任者氏名が入るとシートがロックされA3の許可の取り下げやA4の入力などができません。B列の値を日付にしたい(変化する値)にしたいのですが、"許可"を日付にするにはこのように変更すればいいでしょうか？何度も質問ばかりですみません。

zbat

2019/02/22 03:14

責任者と担当者のマクロの動作が逆になってるようです。シート(neme)のセル(J100:J116)には責任者のUSERNAMEが全て入力されていますか？そして担当者のUSERNAMEが誤入力されていませんか？ A列に担当者の名前が入ると承認されB列に処理日が入る　Worksheet_Changeマクロを回答４に貼ります。 B列の日付を変更するため　for each文は使いません。ただし、問題がありそれを解決する方法が思いつきませんでしたので、注意を良く読んでみて下さい。

行動規範の内容に同意します

あなたの回答