|
こんな感じで使い物になるでしょうか。
以下のプロシージャは、Sheet1のクラスモジュールにコピーしてください。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim r2 As Long 'Sheet2行カウンタ
Dim TargetId As String '社員番号保持
Static Processing As Boolean
'プログラムから値コピーしてもイベントが発生するため、止めるフラグ
If Processing Then Exit Sub
'変更が入ったセルがB1の時のみに限定
If Target.Address = "$B$1" Then
'カウンタ初期化
r2 = 2
'ID確保、念のため半角文字へ変換
TargetId = StrConv(Target.Value, vbNarrow)
Do Until IsEmpty(Sheet2.Cells(r2, 4).Value)
If Sheet2.Cells(r2, 4).Value = TargetId Then
Processing = True
Sheet1.Cells(2, 1).Value = Sheet2.Cells(r2, 2).Value
Sheet1.Cells(3, 1).Value = Sheet2.Cells(r2, 3).Value
Sheet1.Cells(4, 1).Value = Sheet2.Cells(r2, 4).Value
Processing = False
Exit Do
End If
r2 = r2 + 1
Loop
End If
Processing = False
End Sub
|
|