VBA VLOOKUP 別のファイルを参照

このQ&Aのポイント
  • VBA VLOOKUPを使用して別のファイルから値を参照する方法について質問です。
  • 範囲を指定してVLOOKUPを実行したところエラーメッセージが表示されます。
  • 空白の行も含まれるため、if関数を使用してもうまく動作しません。
回答を見る
  • ベストアンサー

VBA VLOOKUP 別のファイルを参照

VBA VLOOKUP 別のファイルを参照 いつもこちらでお世話になっている者です。 VBAの勉強をしております。 別のファイルからVLOOKUPで値を参照したいのですが、 範囲を指定してみましたが、 「worksheetFunctionクラスのVlookupプロパティを参照できません」 とのメッセージが出てしまいます。 なお、値は空白になる行もありますので、 if関数で回避してみましたがうまくいきません。 いろいろ試しましたが、何度やってもうまくいかないので こちらに質問させていただきました。 お詳しい方、ご伝授いただければ助かります。 よろしくお願い致します。 環境はExcel2007です。 Sub sample() Dim 範囲 As Range Dim wb As Workbook, wb2 As Workbook Dim r As Integer,intRow As Integer Workbooks.Open Filename:="***.xlsm" Set wb = ThisWorkbook Set wb2 = ActiveWorkbook Set 範囲 = wb2.Sheets("PvtSht2").Range("Database3") r = wb.Sheets("sheet1").Range("A28:N28").End(xlToRight).ColumnintRow = 3 With wb.Sheets("sheet1") Do Until .Cells(intRow, 1).Value = "" .Cells(intRow, (r + 1)) = Application.WorksheetFunction.If((Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False)) = 0, "", Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False)) intRow = intRow + 1 Loop End With End sub

質問者が選んだベストアンサー

  • ベストアンサー
  • jcctaira
  • ベストアンサー率58% (119/204)
回答No.1

2つ問題があると思います。 1.Application.WorksheetFunction.If WorksheetFunctionには「If」はありません。  単純にVBAのIFを使えば良いと思いますが、結果が「空白」か「0」かまたは  マッチしない時等対応を変えないとだめだと思います。 2.「worksheetFunctionクラスのVlookupプロパティを参照できません」  式は合っているとは思いますが、Range("Database3")が気になります。  試しにRange("A1:B9")等2列以上は問題がありませんが、Range("A1:A9")の1列の場合  上記エラーメッセージが表示されます。  「"Database3"」の範囲を確認した方が良いかと思います。

curo_chan
質問者

お礼

こちらの件、あれから試行錯誤して動くようになりました。 おそらく、wbやwb2をきちんとactivateしてなかったのが、原因と思われます。 助言いただきましてありがとうございました。

curo_chan
質問者

補足

お返事ありがとうございます。 さっそく試してみました。 1.そうだったのですね、if文は外しました。 On Error Resume Next~On Error GoTo 0で挟んでみたのですが問題ないでしょうか? 2.Set 範囲 = wb2.Worksheets("PvtSht2").Range("Database3")を MsgBox 範囲.Addressで試してみましたが、参照してほしい場所がきちんと選ばれていました。 範囲は2列です。 下記のように書き直してみたところ、 vlookupが1行ずつずれてしまうのです・・・ もしお分かりでしたら、ご指南いただけますか、よろしくお願い致します。 Sub test2() Dim wb As Workbook, wb2 As Workbook Dim r As Integer, intRow As Integer Dim 範囲 As Range Dim Database3 As Range Workbooks.Open Filename:="***.xlsm" Set wb = ThisWorkbook Set wb2 = ActiveWorkbook 'wb.Sheets("sheet1").Activate r = wb.Sheets("sheet1").Range("A28:N28").End(xlToRight).Column With wb2.Sheets("PvtSht2") .Range("A4:B" & .Range("A" & _ .Rows.Count).End(xlUp).Row).Name = "Database3" End With Set 範囲 = wb2.Worksheets("PvtSht2").Range("Database3") MsgBox 範囲.Address intRow = 3 With wb.Sheets("sheet1") Do Until .Cells(intRow, 1).Value = "" On Error Resume Next .Cells(intRow, (r + 1)) = Application.WorksheetFunction.VLookup(Cells(intRow, 1), 範囲, 2, False) intRow = intRow + 1 On Error GoTo 0 Loop End With wb.Activate End Sub

その他の回答 (1)

  • myRange
  • ベストアンサー率71% (339/472)
回答No.2

  ちょっと見で気づいた点。 >VLookup(●Cells(intRow, 1), 範囲, 2, False)  ●の部分には .(ドット)が必要だと思いますが。。。   以上です。

curo_chan
質問者

お礼

ありがとうございます。 こちらの件、直してみました。 ありがとうございました。

関連するQ&A

  • VBA VLOOKUpについて

    VBA VLOOKUpについて すいません 例えば B1セルに名前があり Q1セルにIDがあります そこで UserFormを開いた時に表示させたい場合 どのような記述にすれば良いのでしょうか?? Dim wbMyBook As Workbook 'このブックをセット Dim w As Worksheet 'このブックのWシートをセット Dim vRet As Variant '使用するブックとシートをセット Set wbMyBook = Workbooks(ThisWorkbook.Name) Set wsKanjya = wbMyBook.Worksheets("W") vRet = WorksheetFunction.VLookup(TextBox1.Text, _ Sheets("w").Range("A:IV"), _ 17, _ False)   If vRet = "402-B" Then w.Cells(lng, 2) = TextBox1.Text Exit For End If Next lng これでは当然駄目です!! 組み合わせて使うと混乱してしまいます! 記述を教えてください。

  • エクセルVBAで別ブックの条件検索

    VBA初心者です。エクセルは2007です。 『データのあるブック(Book1,Book2,Book3)』と、『検索条件シート+出力先シートをもつブック』の4つのブックがあります。 検索条件シートで、L22でブック、P22でシートを指定してN22に入力した数に対応するデータをVlookupで出力先シートのセルに抽出されるようにしたいのですが、※の部分で「エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません」とでて実行できません。 データのあるブックは同じ形式でシートには表があります。 数 a b c d 1 A B C D 2 ○ × △ ■ 3 Z Y X W     ・     ・ 検索条件がL22=3,P22=2,N22=2だとすると、Book3の2枚目のシートを検索し、 出力先シートのD1=○,J6=×,L23=△,J69=■となるようにしたいです。 本やインターネットで調べましたがわかりませんでした。 解決方法を教えていただきたいです。お願いします。 Sub 検索() Dim a, b, c, d As Range Dim 番号, ブック, シート As Integer With Workbooks("検索.xlsm").Sheets("検索条件") 数 = .Range("N22").Value ブック = .Range("L22").Value シート = .Range("P22").Value End With Dim wb As Workbook Dim sh As Worksheet Dim set範囲 As Variant With Workbooks("検索条件.xlsm").Sheets("出力先") Set a = .Range("D1") Set b = .Range("J6") Set c = .Range("L23") Set d = .Range("J69") End With Select Case ブック Case 1 Set wb = Workbooks("Book1.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case 2 Set wb = Workbooks("Book2.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case 3 Set wb = Workbooks("Book3.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case Else MsgBox "nothing", vbExclamation, "nothing" End Select ※Set set範囲 = wb.sh.Range("A4:E42")  ←エラー438 a = Application.WorksheetFunction.VLookup(数, set範囲, 2, False) b = Application.WorksheetFunction.VLookup(数, set範囲, 3, False) c = Application.WorksheetFunction.VLookup(数, set範囲, 4, False) d = Application.WorksheetFunction.VLookup(数, set範囲, 5, False) End Sub

  • VBAの繰りかえし処理について

    workbook1(以下wb1)のB3に入力した県名を含む行を、 workbook2から取り出し、wb1のB7以降に表示させたいと思っています (ちなみに県名はwb2のC列に入っています) 同じ県名が含まれる行が多いので、それらを繰り返し処理で 全て書き出したいと思い、以下のマクロを作りました。 Sub macro3() Dim c Dim wb1 As Workbook Dim wb2 As Workbook Dim k As Integer Dim firstAddress As String Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set wb2 = Workbooks.Open("G:\zyouhousyori\inn100best_full.csv") Set c = cell.Find(What:=Range("B3").Value) With wb2.Worksheets(1).Range("A1:A100") If Not c Is Nothing Then firstAddress = c.Address Do Set c = cell.FindNext(c) For k = 0 To 10 .Range("C100").End(xlUp).Offset(1).Copy _ wb1.Worksheets("sheet1").Cells(7 + k, 2) Exit For ★Loop While Not c Is Nothing And _ c.Address <> firstAddress End If End With Application.ScreenUpdating = True wb2.Close False End Sub しかし、実行すると★マークのついた所でエラーになってしまいます (対応するDoがありません、と出ます) VBA初心者なので、どこがどう違うのかいまいちわかりません; アドバイスお願いします。

  • エクセルVBAマクロの質問です。

    マクロ初心者です。行き詰まってます。 sheet1には300件程度のデータがあります。 このデータの3列目の値を、VLOOKUPでsheet3のA1:B30範囲から参照します。そこで取得した回数分、sheet1の各行のデータをsheet2にコピーしたいんです。 そこで、コード文を作ってみましたが、マクロがうまく動きません。 すみませんが、お知恵を貸していただけないでしょうか? Dim Z as Long Dim L As Long Dim P As Long Dim Kensaku As String Dim M4 As Range Dim PRow As Long Dim i As Long Set M4 =Sheets(“sheet3”).Range(“A1:B30“) L = Sheets(“sheet1”).Range(“A1”).End(xlup).Row For Z = 1 to L-1 Kensaku = Sheets(“sheet1”).Cells(Z+1,3).Value P=Worksheetfunction.Vlookup(Kensaku,M4,2,False)    For i = 1 to P      Prow=Sheets(“sheet2”).Range("A1").End(xlDown).Row      Sheets(“sheet1”).Rows(Z+1).Copy Sheets(“sheet2”).Rows(Prow)    Nexti Next Z

  • VBAについて質問です。

    VBAについて質問です。 現在、ExcelにてWorkbookを自動で作成するモジュールを作成しています。 モジュールを記載しているWorkbookを [wbSorce] 自動で作成されるWorkbookを [wbNew] とします。 [wbSorce] でモジュールを実行すると、 [wbNew] を新規に作成し、 データを入力して保存するのですが、保存する際に [wbNew] のイベントハンドラ [Workbook_Open] に 保存された [wbNew] を開いた時の挙動を記載するには どうすればよいでしょうか? サンプルは下記になります。 ****[wbSorce]のモジュール**** Sub wbNew_Sakusei()   Dim wb As Workbook   Dim wb2 As Workbook   Dim i As Integer   Set wb = ThisWorkbook   Set wb2 = Workbooks.Add   For i = 1 To 5     wb2.Sheets(1).Cells(1, i) = wb.Sheets(1).Cells(1, i)   Next   wb2.SaveAs Filename:="wbNew" End Sub ****[wbNew]に記述したいモジュール**** Private Sub Workbook_Open()   ActiveWindow.ScrollRow = 1   MsgBox "Workbook_Openイベントが発生しました。" End Sub

  • エクセルVBAでファイル作成

    エクセルVBAで、データをフィルタで抽出し、別なBOOKの指定シートに転記し、名前をつけて保存したいのです。一応、下記のコードでテストは成功しました。 しかし下記コードでは1回ごとにデータの転記先を開かなくてはなりません。 処理する件数が多いので、できればいちいち新たに開き直さなくともよい方法はないでしょうか? 最初から開いておいて、転記後名前をつけて保存すると、開いていたファイルが閉じてしまい、うまくいきません。 別BOOKでなく別シートに転記して、そのシートをMoveして別ファイル保存ならわかるのですが、今回はどうしても別BOOKに転記しなければなりません。 よろしくお願いします。 Option Explicit Sub データ分割転記()   Dim myPth As String, fname As String   Dim myRng As Range, myC As Range   Dim i As Long, x As Long   Dim wb(2) As Workbook   Dim ws As Worksheet   Dim t As Single   t = Timer   Set wb(0) = ThisWorkbook   myPth = wb(0).Path   With wb(0).Sheets("Key")     Set myRng = .Range("A2", .Range("A2").End(xlDown)) 'KeyData   End With      For Each myC In myRng     Application.EnableEvents = False     Set wb(1) = Workbooks.Open(Filename:=myPth & "\20150806TEST.xlsm")     Set ws = wb(1).Sheets("List")        With wb(0).Sheets("DATA")       .Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value       .Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A9")       .ShowAllData     End With     With ws       x = .Cells(Rows.Count, "A").End(xlUp).Row       myC.Offset(, 2).Value = x '行数確認       .Range("A9").Value = 1       If x > 9 Then         .Range("A9").AutoFill Destination:=.Range("A9:A" & x), Type:=xlFillSeries '連番       End If     End With     wb(1).SaveAs Filename:=myPth & "\作成ファイル\" & myC.Value & ".xlsm"     wb(1).Close (False)     Application.EnableEvents = True     i = i + 1   Next   MsgBox i & "件を完了" _   & vbCrLf & Timer - t & " Sec." End Sub *Application.EnableEvents = False を使っているのば別BOOKが持つイベントマクロを作動させないためです。

  • VBAでVLOOKUPを使う際に、別のシートの範囲を参照する方法

    はじめまして、saitou takayukiです。 vbaでデータの処理を行っているのですが、 その際、vlookup関数を使う際に問題がありました。 プログラミングの内容はsheet1で指定した範囲の10列目のデータを vlookup関数で参照し、sheet2のデータへ書き込むのですが、 vbaでvlookup関数がうまく動いてくれません。 ちなみにsheet1で指定した範囲はユーザーフォームを利用しています。 具体的な中身は Application.Worksheets(2).Cells(10,10) = Application.worksheetFunction.VLookup(id_number,hani_range ,10, 0) としていますが、エラーがでて動きません。 hani_rengeが参照範囲なのですが、これは ユーザーフォームで範囲指定することで得たテキスト形式のhani_textをRenge形のhani_range変数に変えたものです。 アドバイスお待ちしております。よろしくお願いします。

  • VBAで Set wb = Sheets(1).Copyができないわけ?

    つい先ほどの質問 4150169 は掲示したコードが抜けておりましたので無視して、こちらにご回答ください。 ほんと抜けた話です。すみません。 以下のマクロtest01はエラーになります。 Sub test01() Dim wb As Workbook Set wb = Sheets(1).Copy 'エラー「オブジェクトが必要です」 End Sub もちろん Dim wb As Workbook Sheets(1).Copy Set wb = ActiveWorkbook と修正すればエラーにならないことは存じていますが、ふと疑問がわきました。 Sheets(1).Copyの段階であたらしいWorkbookが誕生していますよね。 ならば、そのWorkbookはオブジェクトではないのでしょうか? Workbooks.Add で誕生したWorkbookは Set wb = Workbooks.Add と変数wbにSetできるのに Set wb = Sheets(1).Copy ができないのが不思議です。 Set wb = ActiveWorkbook としないでもSheets(1).CopyをwbにSetする書き方はないのでしょうか?

  • VBA コード番号がない場合は、次の行へ進む

    OSはXPPro、 Excelは2003を使用しています。 入金データの「支店データ」シートのコード番号がマスタの表にある時、新シート(test)にコピーするマクロを作ろうと悪戦苦闘しています。 下記までは組んだのですが、「インデックスが有効範囲にありません」とエラーになってしまいます。 マスタにないコードだからだと思っているのですが、そういう場合は次の行のコード番号に進めるステートメントをどう組めば良いか分かりません。 どなたかご教示頂けると有り難いです。 よろしくお願い致します。 Sub test() Dim wb As Workbook Dim ws As Worksheet Dim mypath As String Dim fname As String Dim maxgyo As Long 'マスタの最終行 Dim intRow As Long 'マスタの行 Dim strMasCode As Long   'マスタのコード番号 Dim maxgyo2 As Long '入金データの最終行 Dim intRow2 As Long '入金データの行 Dim strSrhCode As Long '入金データのコード番号 Dim shingyo As Long '新シートの書き込み行 Worksheets.Add After:=ActiveSheet, Count:=1 '新しいワークシートを作成 ActiveSheet.Name = "test"            'そのシートの名前は[test] mypath = "C:\Documents and Settings\XXX\My Documents\XXX\" fname = "マスタ.xls" Set wb = Workbooks.Open(mypath & fname) '上記で指定したブックを開く Set ws = wb.Worksheets("担当マスタ")     '[担当マスタ]シートを指定 Workbooks("入金データ").Activate maxgyo = Sheets("支店データ").Cells(Rows.Count, 1).End(xlUp).Row '支店データの最終行 For intRow = 2 To maxgyo strSrhCode = Worksheets("支店データ").Cells(intRow, 6) shingyo = 1 shingyo = singyo + 1 Workbooks("マスタ").Activate maxgyo2 = Sheets("マスタ").Cells(Rows.Count, 2).End(xlUp).Row 'マスタの最終行 For intRow2 = 2 To maxgyo2 strMasCode = Sheets("マスタ").Cells(intRow2, 2) 'マスタのコード番号を代入 If strSrhCode = strMasCode Then 'マスタと支店データのコード番号が一致したら With Workbooks("入金データ").Worksheets("test") .Cells(shingyo, 1) = Worksheets("支店データ").Cells(intRow, 1) .Cells(shingyo, 2) = Worksheets("支店データ").Cells(intRow, 2) End With End If Next intRow2 Next intRow End Sub

  • エクセルVBAで作成した別ブックにVBAを記述したい

    VBAで別ファイルの作成は下記で出来ているのですが、出来上がったファイルにVBAを記述する方法がわかりません。 具体的には一番下のSub TEST()を新しいブックの標準モジュールに記述したいのと、sheet1に Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "ChangeTEST" End Sub を入れたいです。 また Private Sub Workbook_Open() MsgBox "OpenTEST" End Sub も入れたいのです。 どうぞご教示ください。 Sub 複製() Dim wb As Workbook, sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wb = Workbooks.Add Application.SheetsInNewWorkbook = sc wb.Sheets("Sheet1").Select ThisWorkbook.Sheets("Sheet1").Cells.Copy wb.Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Buttons.Add(123, 195, 68.25, 15).Select Selection.OnAction = "TEST" Selection.Characters.Text = "TEST" ActiveWorkbook.Close ThisWorkbook.Activate Sheets("Sheet1").Select End Sub Sub TEST() MsgBox "TEST!!" End Sub よろしくお願いします。

専門家に質問してみよう