VBA でvlookup エラーなどは削除したい

Question

VBAでvlookupをし、別シート（"商品マスタ"）のデータを検索して所定のシートWorksheets("受注明細")で処理しようとしています。
Worksheets("受注明細")F列（先頭はF6で最終行は都度違います）に製品型番が入力されています。Worksheets("商品マスタ")のA列（先頭はA2で最終行は都度違います）製品型番が入力されています。Worksheets("受注明細")F列をキーとし、Worksheets("商品マスタ")A列をvlookupし、Worksheets("受注明細")I6へ連続で貼り付けし、空白やエラーで出たものは削除したいです。いろいろとサイトを見て自分なりに作成いたしましたが、手作業で行う=VLOOKUP(受注明細!F6,商品マスタ!A:A,1,FALSE)との差異が生じております。本来ならエラーになるのに突合をしてしまっている状態です。またWorksheets("受注明細")のA5:H5にタイトルが入っているのですが、それもなくなってしまいます。
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Worksheets("受発注明細")
Set Ws2 = Worksheets("商品マスタ")

Dim Cmax1 As Long, Cmax2 As Long
Cmax1 = Ws1.Range("A65536").End(xlUp).Row
Cmax2 = Ws2.Range("A65536").End(xlUp).Row

Dim Product_code As String, Master_code As String, Product_name As String
Dim I As Long, j As Long, Product_price As Long

For I = 2 To Cmax1
Product_code = Ws1.Range("F" & I).Value
For j = 2 To Cmax2
Master_code = Ws2.Range("A" & j).Value
If Product_code = Master_code Then
Product_name = Ws2.Range("A" & j).Value
Exit For
End If
Next
Ws1.Range("I" & I).Value = Product_name
Next

lRow = Cells(Rows.Count, "A").End(xlUp).Row

For I = lRow To 2 Step -1

If (Cells(I, "I") = "商品" Or Cells(I, "I") = "#N/A") _
Or Cells(I, "I") = "" Then

Rows(I).Delete
End If

Next I

End Sub

いろいろなサイトを見て自分なりに作成いたしましたが、上記のように手作業で行う=VLOOKUP(受注明細!F6,商品マスタ!A:A,1,FALSE)との差異が生じており、本来ならエラーになるのに突合をしタイトルも消えてしまいます。商品を削除したいのは、 Worksheets("商品マスタ")A列のタイトルが商品となっており、製品型番と一致しないのに#N/Aではなく商品で突合されてしまったため組み込んでおります。初心者ですので、コードを記載してくださるようお願いいたします。お手数ではございますが、ご教示を何卒よろしくお願いいたします。

Qchan1962 · Accepted Answer

CountIfで行う場合

Sub test01()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Worksheets("受注明細")
Set Ws2 = Worksheets("商品マスタ")
Dim Cmax1 As Long, Cmax2 As Long
Cmax1 = Ws1.Range("A65536").End(xlUp).Row
Cmax2 = Ws2.Range("A65536").End(xlUp).Row
Dim Product_code As String
Dim i As Long
Dim rngDel As Range
For i = 6 To Cmax1        'Worksheets("受注明細")
    Product_code = Ws1.Range("F" & i).Value
    If Application.CountIf(Ws2.Range("A2:A" & Cmax2), Product_code) > 0 Then
            Ws1.Range("I" & i).Value = Product_code
    Else
        If rngDel Is Nothing Then
            Set rngDel = Ws1.Cells(i, "I")
        Else
            Set rngDel = Union(rngDel, Ws1.Cells(i, "I"))
        End If
    End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

End Sub

tatsumaru77 · Answer

No3です。
補足ありがとうございました。
製品番号が＊（アスタリスク）を含むことはありますか？
例
K001* 
K*001
のようなケースです。

含まないのであれば、既に良い回答がでていますので、私のほうからの回答はひかえさせていただきます。

Qchan1962 · Answer

#5の方法でご質問コードを添削して書き込み削除するか
下記を試してみてください
Sub test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Worksheets("受注明細")
Set Ws2 = Worksheets("商品マスタ")

Dim Cmax1 As Long, Cmax2 As Long
Cmax1 = Ws1.Range("A65536").End(xlUp).Row
Cmax2 = Ws2.Range("A65536").End(xlUp).Row

Dim Product_code As String
Dim i As Long
Dim codeCell As Range
Dim rngDel As Range
For i = 6 To Cmax1        'Worksheets("受注明細")
    Product_code = Ws1.Range("F" & i).Value
    Set codeCell = Ws2.Range("A2:A" & Cmax2).Find( _
            What:=Product_code, After:=Ws2.Range("A" & Cmax2), LookIn:=xlValues, LookAt:=xlWhole)
    If Not codeCell Is Nothing Then
            Ws1.Range("I" & i).Value = codeCell.Value
    Else
        If rngDel Is Nothing Then
            Set rngDel = Ws1.Cells(i, "I")
        Else
            Set rngDel = Union(rngDel, Ws1.Cells(i, "I"))
        End If
    End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

End Sub

Qchan1962 · Answer

＞先頭はF6で最終行は
For I = 2 To Cmax1　＝＞　For I = 6 To Cmax1
　
ご質問のループで行う・・A:A,1,FALSE

For i = 6 To Cmax1
Product_code = Ws1.Range("F" & i).Value
Product_name = "#N/A"
For j = 2 To Cmax2
If Product_code = Ws2.Range("A" & j).Value Then
Product_name = Product_code
Exit For
End If
Next
Ws1.Range("I" & i).Value = Product_name
Next

Qchan1962 · Answer

こんにちは
＞初心者ですので、コードを記載してくださるようお願いいたします。
不明な点がありますので取り敢えず、ご自身で出来る事として

ご質問には　３つシートが出てくるようですが（打ち間違えかな？）
実際には4つシートが出てきています（1つは　たぶん重複）
①別シート（"商品マスタ"）
②Worksheets("受注明細")
③Worksheets("受発注明細")
④ActiveSheet　上記にたぶん重複
どのシートに対して処理をするのか考えて（Ws1.Rangeみたいに）
下記コードのシートオブジェクトを明示してみましょう

lRow = Cells(Rows.Count, "A").End(xlUp).Row
For I = lRow To 2 Step -1
If (Cells(I, "I") = "商品" Or Cells(I, "I") = "#N/A") _
Or Cells(I, "I") = "" Then
Rows(I).Delete

tatsumaru77 · Answer

各シートの正確なレイアウトが判りません。
添付図のような画像を提示していただけませんでしょうか。
（このような画像はwindows アクセサリのSnipping toolで作成できます）

上の画像が商品マスタです。（B列は想像です）
下の画像が受発注明細です。（I列は想像です）
尚、画像作成時、列と行のガイド（添付図の赤線で囲んだ部分）を必ず含めてください。そうしないと、正確なレイアウトが判りません。

mygoonickname · Answer

こんばんは。

直接の回答ではありませんが、関数で処理してはダメなのでしょうか？
IFERROR関数との組み合わせで、エラー時は空白表示にすれば良い様な
気がしますが。。。

●VLOOKUPのエラーをIFERROR関数で非表示に
https://www.becoolusers.com/excel/iferror-vlookup.html

めくりや · Answer

なにをしようとしているかわからない。ISERROR関数は使ってますか？削除ってなにをどう削除したいのか意味がわからない。

【Excel】ISERROR関数の使い方｜VLOOKUP関数やIF関数との組み合わせ
https://leo-pcblog.com/excel-iserror/

VBA でvlookup エラーなどは削除したい

CountIfで行う場合

No3です。

#5の方法でご質問コードを添削して書き込み削除するか

＞先頭はF6で最終行は

こんにちは

各シートの正確なレイアウトが判りません。

こんばんは。

なにをしようとしているかわからない。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング