Changeイベントで複数セルへの貼り付けおよび値削除時に1個目のセルのみエラーになる

下記はAシートのコードで、C列をTargetとしています。C列に社員番号を入力し、Enterを押すと社員名に切り替わって表示され、存在しない番号の入力や直接入力（社員名を直接入力する人もいるため）でもエラーが出ないよう「On Error Resume Next」を追加しております。
Bシートに社員情報が記載されており、BシートのA列が社員番号、C列に社員名の一覧があります。

下記のコードの状態で、AシートのC列の複数行に貼り付け、もしくは複数行の値を一気に削除（Deleteを押す）すると、両者とも１個目のセルのみがN/Aとなってしまいます。

１個目のセルにも問題なく張り付け、および削除が成功するコードを教えて頂けますでしょうか。

＜現在のAシートのコード＞
Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Column = 3 Then

With Cells(Target.Row, Target.Column)
.Value = WorksheetFunction.VLookup(Target.Cells, Worksheets("B").Range("A2:B5001"), 2, False)
End With

End If

On Error GoTo 0

End Sub

No.2 ベストアンサー 回答者： fujillin 回答日時： 2022/12/21 13:24

こんにちは

Changeイベントで渡されるTargetはセル範囲です。

＞AシートのC列の複数行に貼り付け、もしくは複数行の値を一気に
＞削除（Deleteを押す）すると、両者とも１個目のセルのみが
＞N/Aとなってしまいます。
ご提示のコードは単独セルが変更された場合を想定していて、複数セルの変更に対応していないため、セル範囲を渡された場合には処理できません。
複数行に貼り付けた場合に、1行目が#N/Aになるだけで、2行目以降は処理されていないものと想像します。
あるいは、B2:C5のようなセル範囲にコピペした場合には、何も処理されないことになっていませんか？

＞１個目のセルにも問題なく張り付け、および削除が成功する
＞コードを教えて頂けますでしょうか。
1個目が処理できるようにするだけでは、本当のご要望に応えていないのではないかと思います。
変更のあった全部のセルに対応なさりたいのでしょうから、コードを複数セルに対応可能なように修正する必要があります。
簡単な方法の一例として、Targetの範囲内のセルに対してループ処理をすれば良いです。

ご質問文からは「一覧表にない値を入力した場合にどうするのか」が不明ですが、その場合には「何もしない」と仮定してもよいのなら、以下ご参考までに。
（現実的には、A列になければ、B列を検索して同じものがなければ「該当無し」などの表示にした方が良いのかも知れませんけれど・・）

Private Sub Worksheet_ChangeF(ByVal Target As Range)
Dim c, r
Set r = Worksheets("B").Range("A2:B5001")

Application.EnableEvents = False
For Each c In Target.Cells
If c.Column = 3 And c.Value <> "" Then
If Not r.Columns(1).Find(c.Value, , xlValues, xlWhole) Is Nothing Then
c.Value = WorksheetFunction.VLookup(c.Value, r, 2, False)
End If
End If
Next c
Application.EnableEvents = True
End Sub

この回答へのお礼

頂いたコードで改善されました！
本当にどうも有難うございました！！

お礼日時：2022/12/22 12:07

No.3 回答者： rexfan 回答日時： 2022/12/22 09:40

本来作業以外の操作がC列に対して行なわれた場合を

排除する必要があります。
Targetのセル数が1以外は抜ける処理を入れましょう。

この回答へのお礼

ご回答頂きどうもありがとうございました。

お礼日時：2022/12/22 12:06

No.1 回答者： t_fumiaki 回答日時： 2022/12/21 11:08

("A2:B5001"), 2, False)が相対アドレス指定になってるからでは？

絶対アドレスにすれば良いと思います。

("A2:B5001")　→　("$A$2:$B$5001")