| |
▼β様
＞マクロ処理をしなくても、手作業で、注文書シートの該当セルの書式を変更して＞おけばいいのでは？
手作業でロックしたら、注文書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
|
|
β
- 15/7/24(金) 2:50 -
マナ
- 15/7/23(木) 20:19 -
- 15/7/23(木) 16:39 -
tomi
- 15/7/23(木) 4:06 -
