Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5018 / 76732

←次へ　｜　前へ→


	【77328】Re:パスワードでロック

翔子 - 15/7/7(火) 9:55 -


	引用なし

	パスワード

▼β様

＞マクロ処理をしなくても、手作業で、注文書シートの該当セルの書式を変更して＞おけばいいのでは？

手作業でロックしたら、注文書Sheetに

'1 Sheet注文書（E2）コードを入力enterで
'2 Sheet詳細（E列コード）,（F列品名）から
'　Sheet注文書（E3）に品名を持ってくる
'Sheet注文書での処理
'3 D6に値が入ったら、C6にE3の品名が入るように。
'4 D7に値が入ったら、C7にE3の品名が入るように。
'5 D8に値が入ったら、C8にE3の品名が入るように。
'6 D9に値が入ったら、C9にE3の品名が入るように。
'7 D10に値が入ったら、C10にE3の品名が入るように。

'入力のあったセルが [E2]のときは (1) を実行し、
'[D6:D10]のときは (2)を実行するように If～ Else～ End If構文で分岐処理

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Dim c As Range
'(1) -----------------------------------------------------------
If Target.Address(0, 0) = "E2" Then
　　Dim m As Variant
　　With Worksheets("詳細")　'別シートのコード照合セル範囲
　　　　 Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
　　End With
　　Application.EnableEvents = False
　　If IsEmpty(Target) Then
　　　　Target.Offset(1).ClearContents
　　Else
　　　　m = Application.Match(Target, Rg, 0) 'Match関数で検索
　　　　 If IsNumeric(m) Then
　　　　　　Target.Offset(1).Value = Rg.Item(m, 2).Value
　　　　Else
　　　　　　Target.Offset(1).ClearContents
　　　　　　MsgBox "入力されたコードはありません"
　　　　End If
　　End If
　　Application.EnableEvents = True
　
'(2) -----------------------------------------------------------
Else
　　Set Rg = Intersect(Target, Range("D6:D10"))
　　If Rg Is Nothing Then Exit Sub

　　 Application.EnableEvents = False
　　For Each c In Rg
　　　　If Not IsEmpty(c.Value) Then
　　　　　　c.Offset(, -1).Value = Range("E3").Value
　　　　End If
　　Next
　　Application.EnableEvents = True
End If
End Sub
が、作動しないのです。

Sheets("注文書")E2,E4,G4以外ロック。

Sheets"詳細")A1:F893にロック。

Private Sub Workbook_Open()
Sheets("注文書").Select
　　　　　 Range("A1").Value = Date

630 hits

▼

【77245】パスワードでロック 翔子 15/6/25(木) 17:23