| |
ちょっと出かけますので、とりあえずあてずっぽで m(_ _)m
'入力のあったセルが [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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
