エクセルマクロVLookupについて

質問

定義ブック.xlsm　：　項目名、項目カテゴリ名、項目名長、文字種類　を定義する為ブック。
辞書ブック.xls　：　項目カテゴリ名、項目名長、文字種類をこのブック内で色々処理して設定している。

定義ブックの項目名で検索し、
辞書ブックの項目カテゴリ名、項目名長、文字種類を参照してくる。

定義ブックを開いた時に辞書ブックの内容から値を参照（vlookup）するようにしたいです。
定義ブック、辞書ブック、ともに今後、行数が増える想定なので、
何行目まで、というのを変数にしてマクロで実装しようとしています。

そこで、
Application.WorksheetFunction.VLookup()
を使ってみたのですが、そのセルが正常に値を表示しません。
vlookupをセルにベタ書きにすれば値は取得できている為、検索値が見つからない為にエラーになっている系統ではないハズです。
エクセルのバージョンは2007です。

また、エクセルにvlookupをベタ書きするようにマクロを組むと、それは正常に値を表示します。
（最悪この手ですが…、セルにカーソルを合わせるとvlookupの式が表示され、避けたいトコロです）

どのように修正すれば良いでしょうか…？
マクロは初心者です…。

以下、ソースの抜粋です。

******************************************
Dim ItemCode As Variant
Dim SerchArea As Variant
Dim LastRow As Long

'辞書ブックをアクティブにする
Workbooks("辞書ブック.xls").Activate
ActiveWorkbook.Worksheets("辞書シート").ActivateLastRow = Cells(Rows.Count, 1).End(xlUp).Row

'項目数を取得
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

'最終行を取得（辞書ブック.辞書シートのvlookupを何行目までの範囲にするか）
SerchArea = "[辞書ブック.xls]辞書シート!$B$5:$F$" & LastRow

'定義ブックをアクティブにする
Workbooks("定義ブック.xlsm").Activate
ActiveWorkbook.Worksheets("定義シート").Activate

For I = 11 To ColumnCnt
'C11セルから下へ、項目名を検索値として取っていく
ItemCode = Cells(I, 3)
'辞書ブックから値を取得（項目カテゴリ名）　【この書き方だとセルには「value!」と表示される】
Cells(I, 16).Value = Application.VLookup(ItemCode, SerchArea, 2, False)

'辞書ブックから値を取得（項目名長）　【この書き方ならセルには正しく値が表示されるけど、勿論、セルにカーソルを合わせると、vlookupの式が表示される】
Cells(I, 38).Value = "=VLOOKUP(C" & I & ",[辞書ブック.xls]辞書シート!$B$5:$F$" & LastRow & ",4,FALSE)"
Next I

回答No.1

weboner · ベストアンサー

>何行目まで、というのを変数にしてマクロで実装しようとしています。

辞書の範囲が増えても
Range("B:F")
と指定すれば最終行を求める必要はないのですが

マクロ上でVLOOKUPを利用する場合
Application.VLookup(検索値, 範囲, 列番号, 検索方法)

範囲（SerchArea） は Rangeオブジェクトです

ちと修正すると

Sub sample()
'ここから
Dim objWBK As Workbook
Dim objSH As Worksheet
Dim SerchArea As Range
Set objWBK = Workbooks("辞書ブック.xls")
Set objSH = objWBK.Worksheets("辞書シート")
Set SerchArea = objSH.Range("B:F")
'ここまでが検索範囲の定義です

For I = 11 To ColumnCnt　　'ColumnCntは変数ですか？提示されたマクロには定義されていませんが、そのまま残しておきます

ItemCode = Cells(I, 3)
Cells(I, 16).Value = Application.VLookup(ItemCode, SerchArea, 2, False)
Next
End Sub

これで動くな？

お礼

ありがとうございました！無事想定通りに動きました！

回答No.2

weboner

追記：
ちなみにVLOOKUPでは項目は1つしか取得できないため4項目をコピーするのに4回実行が必要ですが

Findメゾットを利用すると

Sub sample()
Dim objWBK As Workbook
Dim objSH As Worksheet
Dim SerchArea As Range
Dim ItemCode As Range
Set objWBK = Workbooks("辞書ブック.xls")
Set objSH = objWBK.Worksheets("辞書シート")
Set SerchArea = objSH.Range("B:B")

For I = 11 To ColumnCnt
Set ItemCode = Cells(I, 3)
Buf = SerchArea.Find(What:=ItemCode.Value).Offset(0, 1).Resize(1, 4)
ItemCode.Offset(0, 1).Resize(1, 4) = Buf
Next

End Sub

一回の処理で4列分コピーできます