Excel2013VBAでVLOOKUP条件付き

質問

いつもお世話になっております。
Excel2013VBAでVLOOKUP関数を使用して、商品名に対応した商品コードをとりたいのですがうまくいきません。

アクティブシートの表のA列、D列、G列に商品名を複数入力してあります。
テーブルシートのB列に同じく商品名があり、C列に商品コードがあります。
VLOOKUPを使ってテーブルシートから商品コードを取り出して、アクティブシートのA列、D列、G列の商品名の下の行に商品コードを入力するにはどうすればよろしいでしょうか？

条件として、テーブルシートのC列の商品コードは空白のものが存在する。その場合は処理する必要なし。
アクティブシート内の商品名の下の行が空白の場合のみ処理を行う。商品名が連続して入力してある箇所で商品コードが存在する場合は、メッセージでセル番地を表示して、処理を中断。ただし連続して入力してあっても、商品コードが存在しないものは問題なしとして次の処理を行う。

一部作りかけのものを提示します。また、下記コードはブレークポイントで停止しながらだと一応動作していましたが、普通に動かすとフリーズを起こします。すいません。

たびたびすいませんが、よろしくお願いいたします。

Sub VLOOKUP検索()

Dim h As Range, ac As Range

Application.ScreenUpdating = False

Set ac = ActiveWindow.ActiveCell

On Error Resume Next

For Each h In Range("A:A,D:D,G:G")
If h.Offset(1, 0) = "" Then
h.Offset(1, 0) = Application.WorksheetFunction.VLookup(h, Worksheets("テーブル").Range("B:C"), 2, False)
End If
Next

Application.ScreenUpdating = True

ac.Select

End Sub

回答No.1

keithin · ベストアンサー

＞For Each h In Range("A:A,D:D,G:G")

Ａ，Ｄ，Ｇ列の全てのセルを対象にするのは、やりすぎです。エラーの間接的な原因もここにあると想定できます。

sub macro1()
　dim h as range
　dim buf as variant
　on error resume next

　for each h in range("A:A,D:D,G:G").specialcells(xlcelltypeconstants)
　　buf = ""
　　buf = application.worksheetfunction.vlookup(h.value, worksheets("テーブル").range("B:C"), 2, false)

　　if h.offset(1) = "" then
　　　h.offset(1) = buf
　　elseif buf <> "" then
　　　h.select
　　　msgbox h.address
　　　exit sub
　　end if
　next
end sub

お礼

やりすぎですか。でも教えていただいたものだと問題なく動作しました。どうもありがとうございました。