[[20120321210300]]　『セルの保護』（だいご）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『セルの保護』（だいご）
Ｄ1とＥ1のセルの数字が同じになったらＡ1　Ｂ1　Ｃ1をセルを保護できるマクロできませんか？ 
 A1 B1 C1 セルの書式の保護は、マクロ記録をすればできるよね。
 また、セルの保護だけをしても、シート保護をしなければ無意味なんだと言うことは理解してる？
 なので、このシートは、あらかじめ入力の可能性のあるセルの保護をはずした上でシート保護がかかっている？
 それとも、指定条件になったら、はじめてシート保護をかけたいのかな？
 もし、そうだとして、各セルの初期値は保護なんだけど、指定条件になったら、A1 B1 C1 以外のセルの保護をはずすということでいいのかな？


 もし、↑で言っている意味がわからなければ、もう少し説明するので、わからないと言ってね。


 追記）で、指定条件じゃなくなったら、また A1 B1 C1 のセルの保護ははずしたいの？


 (ぶらっと)

 蘊蓄をたれる前に（？）以下のコードを、そのシートのシートモジュールに貼り付けてみて。
（シートタブを右クリック-->コードの表示　ででてくるところ）
想定と違えば、どこが違うかを教えてね。


 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D1:E1")) Is Nothing Then
        If Range("D1").Value = Range("E1").Value Then
            Me.Unprotect
            Cells.Locked = False
            Range("A1:C1").Locked = True
            Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, _
                AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
            Me.EnableSelection = xlUnlockedCells
        Else
            Me.Unprotect
        End If
    End If
 End Sub


 (ぶらっと)
ぶらっとさんありがとうございます。
すみませんＤ1には=SUM(Ａ1:Ｅ1)と関数が入ってしまいマクロが動きませんでした。
手動で入力だとうまくいきます。（だいご） 
 マクロを動かすと式が入ったということじゃなく、D1には式がはいっているということなんだね？
 それにしては D1 の式が　=SUM(Ａ1:Ｅ1)　？？
 これだと循環参照になっちゃうよ？　もしかして式は　=SUM(Ａ1:C1) ?
 いずれにしても
 If Not Intersect(Target, Range("D1:E1")) Is Nothing Then
 これを
 If Not Intersect(Target, Range("A1:E1")) Is Nothing Then
 にかえてためしてみて。


 (ぶらっと)
ぶらっとさん回答ありがとうございます｡助かります
早速コード入れ替えてみました｡
動き的には理想どうりでしたが1つだけ変な動きをしてしまいますので又
教えてください｡
合計D1と在庫E1が同じ数字の意味が違っていました｡
A1　B1　C1に数値が入ります。そしてD1にSAM(A1：C1)と数式があります。
例えばD1合計5 E1在庫が5だとします｡その時A1に6と入れると在庫をオーバー
しても数字が入力されてしまい保護がかかってしまいました｡
これを在庫が5なら5まで入力でき6を入力すると入力できないようにできませんか？
A1に2　B1に2　C1に2でも6になるのでこんな時も入力できないようにできませんか？
宜しくお願いします｡
実際のコードです｡このコードがA11から始まりA54の列まで続きます｡書ききれるか
心配ですが見てください
Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("F11:S11")) Is Nothing Then
        If Range("T11").Value = Range("U11").Value Then
            Me.Unprotect
            Cells.Locked = False
            Range("F11:S11").Locked = True
            Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, _
                AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
            Me.EnableSelection = xlUnlockedCells
        Else
            Me.Unprotect
        End If
    End If
    If Not Intersect(Target, Range("F12:S12")) Is Nothing Then
        If Range("T12").Value = Range("U12").Value Then
            Me.Unprotect
            Cells.Locked = False
            Range("F12:S12").Locked = True
            Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, _
                AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
            Me.EnableSelection = xlUnlockedCells
        Else
            Me.Unprotect
        End If
    End If
    If Not Intersect(Target, Range("F13:S13")) Is Nothing Then
        If Range("T13").Value = Range("U13").Value Then
            Me.Unprotect
            Cells.Locked = False
            Range("F13:S13").Locked = True
            Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, _
                AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
            Me.EnableSelection = xlUnlockedCells
        Else
            Me.Unprotect
        End If
    End If
 End Sub
(だいご)


 昨日から思ってたんですけど ↓ と同じ人？
[[20120321202925]]『在庫以上セルに入力禁止』（みき）


 （JPN）

はい！そうです。両立できないかなーっと思いまして質問しました。（だいご） 
 この質問者さんと同じと前提で回答しますと・・・
 ここの板とセル番地が違いますが（在庫以上セルに入力禁止）のセル番で・・・・
 上のコードと
 行目から入力範囲を選択して[入力規則]


 入力値の種類：ユーザー設定
 数式　　　　：=SUM($A1:$E1)<=$G1
 を組み合わせればうまくいくと思いますよ？
 入力規則を設定がいやならぶらっとさんの回答を待ってみてください。
 マクロ処理のが簡単でしょうが勉強に入力規則も勉強してみては」いかがでしょう？
 もし一緒のコードが書けるならぶらっとさん回答してあげてください。私には無理ですので・・・・

 要件　A列～C列の入力とD列の式、在庫がE列。　これらとアップされたコードの列が異なるけど要件に従って。
 で、当初は１行目だけで対応していたので、コード内でシート保護、非保護を行っていたんだけど
ある行は保護、ある行は非保護ということができなくなる。
（前に言ったとおり、セル領域の保護、非保護はできるけど、それが有効になるにはシートを保護しなきゃいけない。
　シートを非保護にすると、他の行で保護されているセルも入力可能になってしまう。）


 コードは以下だけど、あわせて以下の操作をしておいて。
１．セルをすべて選び、セル書式->保護タブで　ロック(L)のチェックをはずす。
２．シート保護。許可する操作を、保護されたセルの選択｢以外｣すべてチェックをつける。


 Private Sub Worksheet_Change(ByVal Target As Range)


    If Not Intersect(Target, Range("A1:E54")) Is Nothing Then


        If Target.Count > 1 Then
            MsgBox "複数セルへの同時入力はサポートしていません" & vbLf & "入力を取り消します"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        Else


            Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, _
                AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, _
                UserInterfaceOnly:=True
            Me.EnableSelection = xlUnlockedCells


            With Target.EntireRow
                If .Range("D1").Value > .Range("E1").Value Then
                    MsgBox "在庫量を超える入力はできません" & vbLf & "入力を取り消します"
                    Application.EnableEvents = False
                    Application.Undo
                    Application.EnableEvents = True
                ElseIf .Range("D1").Value = .Range("E1").Value Then
                    .Range("A1:C1").Locked = True
                Else
                    .Range("A1:C1").Locked = False
                End If
            End With
        End If


    End If


 End Sub


 (ぶらっと)

 ↑　事前作業の２．は不要。（コードの中でやっていた）
 で、コードは↑でもいいけど、ちょっとだけコード行数を減らしたので以下を使って。


 Private Sub Worksheet_Change(ByVal Target As Range)


    If Not Intersect(Target, Range("A1:E54")) Is Nothing Then


        If Target.Count > 1 Then
            MsgBox "複数セルへの同時入力はサポートしていません" & vbLf & "入力を取り消します"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        Else


            Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, _
                AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, _
                UserInterfaceOnly:=True
            Me.EnableSelection = xlUnlockedCells


            With Target.EntireRow
                If .Range("D1").Value > .Range("E1").Value Then
                    MsgBox "在庫量を超える入力はできません" & vbLf & "入力を取り消します"
                    Application.EnableEvents = False
                    Application.Undo
                    Application.EnableEvents = True
                Else
                    .Range("A1:C1").Locked = .Range("D1").Value = .Range("E1").Value
                End If
            End With
        End If


    End If


 End Sub


 (ぶらっと)

 ↓へ続いています。
[[20120324215647]]　『エラー』（ｋｋ）


 (HANA)
コメント返信：

[ 一覧(最新更新順) ]

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.