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

解決済

質問者：7ujm
質問日時：2022/12/21 09:07
回答数：3件

下記は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

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (3件)

ベストアンサー優先
最新から表示
回答順に表示

参考程度に

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