マクロ VBA 別ブックＡ列の値と一致した時、任意のセルに値を転記(VLookup)で転記が変

Question

またお世話になります。
教えてください。
下記コードで、一致⇒抽出⇒転記まではできたのですが、
各列で一致していない値が入った行まで値が入ってしまいます。
なぜなのかさっぱり分かりません。

※一致させる値は１３ケタのＪＡＮコードです。

【追記】
もう少し詳細に症状を・・・
結局何が原因か分かりません・・・#N/Aとかは出ないんですが。
On Error Resume Next
で片方の検索列が空白だった場合飛ばすようにしています。
実際途中までは空白なのですが、
例えば、
３００行目が一致、Ｅ，Ｆ，Ｇ列に値が入る。
次に、
３１０行目が一致、Ｅ，Ｇ，Ｆ列に値が入る。

なのですが、３０１～３０９行目に３００行で転記した情報が入ってしまいます。
つまり、一度一致したら次の一致が見つかるまで転記を繰り返す状態になっているようです。
エラー時の処理としてVLookupコードの下に
On Error GoTo 0

とか入れると「型が一致しません」と出ます。

あと、別ブックにはフィルターやマクロが入っていますが、影響を及ぼすことはありますか？

Option Explicit

Sub 更新ボタン()
  Application.ScreenUpdating = False
  Dim i As Long
  Dim xlBook As Workbook
  Dim size As String
  Dim Shohin As String
  Dim strColor As String
  
  Worksheets(2).Activate
  Worksheets(2).Range("E5:G10004").ClearContents

  Set xlBook = Workbooks.Open(Filename:=ThisWorkbook.Path & "\商品Master（マクロ）.xlsm")  '★要変更★
  
  On Error Resume Next
   
  For i = 5 To 10004
  'サイズを抽出してＦ列へ
  size = Application.VLookup(ThisWorkbook.Worksheets(2).Range("C" & i).Value, xlBook.Worksheets("商品Master").Range("A6:G10000"), 6, False)
  ThisWorkbook.Worksheets(2).Range("F" & i).Value = StrConv(size, vbWide) '全角にして転記
  
  
  '品名を抽出してＧ列へ
  Shohin = Application.VLookup(ThisWorkbook.Worksheets(2).Range("C" & i).Value, xlBook.Worksheets("商品Master").Range("A6:G10000"), 5, False)
  ThisWorkbook.Worksheets(2).Range("G" & i).Value = StrConv(Shohin, vbWide) '全角にして転記

  
 
  '商品＋カラー抽出して結合してＥ列へ
  Shohin = Application.VLookup(ThisWorkbook.Worksheets(2).Range("C" & i).Value, xlBook.Worksheets("商品Master").Range("A6:G10000"), 5, False)
  strColor = Application.VLookup(ThisWorkbook.Worksheets(2).Range("C" & i).Value, xlBook.Worksheets("商品Master").Range("A6:G10000"), 7, False)
  ThisWorkbook.Worksheets(2).Range("E" & i).Value = StrConv(Shohin & " " & strColor, vbWide)
  Next i

  xlBook.Close
  
  Application.ScreenUpdating = True
  MsgBox ("完了")
End Sub

Comments

[koji9412]

失礼します。今回の質問を初めてみた人は前回の質問を見た上で回答しなければなりません。その上で別途回答します

[marutoki]

言葉足らずですみません、前回の問題は解決し、無事稼働していたのですが、急に症状が現れて困っているところです。（症状は追記しました）

Answer 1

On Error Resume Next
こちらを削除すれば、値は入りません。

しかし、このような書き方ですが、型が違うとエラーが出るかもしれません。

引用
http://www.relief.jp/itnote/archives/excel-vba-error-trap-vlookup-function.php

Sub VLookupのサンプル_エラー回避_1()
 Dim tbl As Range
 Dim key As Long
 Dim ret As String

 Set tbl = Range("D1:E5")
 key = Range("A1").Value

 On Error Resume Next
 ret = WorksheetFunction.VLookup(key, tbl, 2, False)
 If Err.Number <> 0 Then
  ret = "該当なし"
 End If
 On Error GoTo 0

 Range("B1").Value = ret

End Sub

エラー処理も考慮にいれてコードを書くようにしましょう。
また蛇足ですがShohin = ・・・ の部分が2回あるので1つは不要です。

Comments

[marutoki]

ありがとうございます、蛇足の件、お恥ずかしい限りです。
エラー処理後がいまいち分からずいたのですが、ＩＦ文を使えばよかったのですね。
しかし試したのですが、今度は「型が一致しません」と出てきてしまいます。
今回の症状は何が原因なのか、取り込み先のブックにフィルターやマクロが入っているのって関係しますでしょうか？

Answer 2

う～ん、とりあえず型が一致しないので、（Valiantにしても）

Option Explicitを外して
Dim size
Dim Shohin
Dim strColor

にしたら治りました！
全然解決してませんが(-_-;)
一応症状は治りました。