またお世話になります。
教えてください。
下記コードで、一致⇒抽出⇒転記まではできたのですが、
各列で一致していない値が入った行まで値が入ってしまいます。
なぜなのかさっぱり分かりません。
※一致させる値は13ケタのJANコードです。
【追記】
もう少し詳細に症状を・・・
結局何が原因か分かりません・・・#N/Aとかは出ないんですが。
On Error Resume Next
で片方の検索列が空白だった場合飛ばすようにしています。
実際途中までは空白なのですが、
例えば、
300行目が一致、E,F,G列に値が入る。
次に、
310行目が一致、E,G,F列に値が入る。
なのですが、301~309行目に300行で転記した情報が入ってしまいます。
つまり、一度一致したら次の一致が見つかるまで転記を繰り返す状態になっているようです。
エラー時の処理として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 'サイズを抽出してF列へ 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) '全角にして転記 '品名を抽出してG列へ 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) '全角にして転記 '商品+カラー抽出して結合してE列へ 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
回答2件
あなたの回答
tips
プレビュー