質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.92%

VBA:VLOOKUPにて別ブックを参照し最終行までループ(繰り返し)処理する方法

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 577
退会済みユーザー

退会済みユーザー

すいません、、、
教えてください。><

VBAにてVlookupで別ブックにある値を貼り付けし、
それを最終行まで処理を行いたいと思っております。

別ブックから参照するまでは出来たのですが、
繰り返し処理に関してうまく起動せず困っております。

お手数おかけしてますが、
お力をお貸し頂けると幸いです。

宜しくお願い致します。

Option Explicit


Sub オートフィルとVlookUp()

    Dim x As String

    Dim ex As New Excel.Application

    Dim sPath As String

    Dim wb As Workbook

    Dim i As Integer

    ' ループ処理する

    For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row

    '値を取得

    x = Range("Q" & i + Cells(Rows.Count, 1).End(xlUp).Row).Formula


    '開くブックを指定

    sPath = "C:\Users\ファイル名.csv"



    '読み取り専用で開く

    Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)


    With ActiveSheet

        '(1列目)の値を表示

        Range("A" & i + Cells(Rows.Count, 1).End(xlUp).Row).Formula = Application.WorksheetFunction.VLookup(x, wb.Worksheets("シート名").Range("A:E"), 5, False)

    End With


    Next

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • 退会済みユーザー

    退会済みユーザー

    2020/07/21 13:57

    ご返信ありがとうございます。

    エラーになりました。
    値を1に変更した所、A2(空白セルの始まり)は転機出来たのですが、
    繰り返し処理が出来ない状況となっております。。。

    何か解決方法ございますでしょうか、、、
    ご教示頂けますと幸いです。

    キャンセル

  • 退会済みユーザー

    退会済みユーザー

    2020/07/21 14:07

    >繰り返し処理に関してうまく起動せず困っております。
    何が起動しないのか追記された方が宜しいかと思います。
    また、出来ることであれば、F8で(デバック→ステップイン)行単位の実行を行い、どの行が不良なのかフォローされた方が良いかと思います。

    tosiさん
    ご返信ありがとうございます。

    VBAの実行時エラーが表示されます。
    1004のエラーが出ており、
    worksheetfunctionクラスのVlookupプロパティを取得できません。

    と表示されます。

    Range("A" & i + Cells(Rows.Count, 1).End(xlUp).Row).Formula = Application.WorksheetFunction.VLookup(x, wb.Worksheets("report1594796415383").Range("A:E"), 5, False)

    こちらの箇所で上記エラーが表示されます。

    ご指摘ありがとうございます。

    キャンセル

  • tosi

    2020/07/21 14:53 編集

    エラーは1つだけでは無いような気がします。
    VLookup(x, のXですが、Rangeを指定する場所ですが、・・・.Row).Formulaを当てています。
    Range("A" & i ・・・はWith ActiveSheetの中にありますが、.Rangeとはなっていません。
    Set wb = ex.Workbooks.Open後にRange("A" & i が動いていいるため、ActiveSheetはOpenしたwbブックのシートになっている可能性あります。

    エラー部分を個別に分けて、どの部分が問題なのか確認が必要と思います。
    分解方法
    dim MyTest as range '定義します。
    1.Range("A" & i + Cells(Rows.Count, 1).End(xlUp).Row).Formula=”=0”
    2.set MyTest = wb.Worksheets("report1594796415383").Range("A:E")
    3.Range("A1").Formula = Application.WorksheetFunction.VLookup(Range("A1"),Range("A:E"), 5, False)
    分解した各行でエラーはでませんか。
    先ずは、こちらを通されてから、再度まとめて行います。
    この先でのエラーはセル/シートを全然別のところから引いていることが多いです。
    別ブックの起動を行い処理していますので、発行するコマンドが適切なシートに対して行っているのか確認する様になるかと思います。

    (尚、エラー行の記述の仕方は私的には複雑な記載方法をしているな~と感じています。)

    キャンセル

回答 1

checkベストアンサー

0

いまいちループの作りがよくわかりません。何を基準にループしようとしているのか。。。
Q列の値をキーにVLOOKUPして結果をA列にセットする??
元のシートの説明がないと、回答難しいと思います。

「worksheetfunctionクラスのVlookupプロパティを取得できません」のエラーは、VLOOKUPの結果、検索値が見つからないときに発生するようなので、見つからないときの処理を書けばいいのではないかと思います。
こちらの勝手な解釈で書いてみました。

Sub オートフィルとVlookUp()
    Dim x As String
    Dim ex As New Excel.Application
    Dim sPath As String
    Dim wb As Workbook
    Dim i As Integer

    '開くブックを指定
    sPath = "C:\Users\xxxxxx\desktop\ファイル名.csv"
    '読み取り専用で開く
    Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)


    ' ループ処理する
    For i = 1 To Cells(Rows.Count, 17).End(xlUp).Row
        '値を取得
        x = Range("Q" & i).Formula

        With ActiveSheet
            '(1列目)の値を表示
            On Error Resume Next
            Range("A" & i).Formula = Application.WorksheetFunction.VLookup(x, wb.Sheets(1).Range("A1:E10"), 5, False)
            If Err.Number <> 0 Then
                Range("A" & i).Formula = Err.Description
            End If
        End With
    Next

    wb.Close
    Set wb = Nothing
End Sub
  • ループの中でCSVファイルを何度も読むのは無駄だと思ったので先頭で読んでいます。
  • ループがよく分からなかったので、Q列基準にループに勝手に直しました。
  • vlookupのところ、wb.Sheets(1).Range("A1:E10")に変えてます。A:Eの範囲だと広すぎて時間かかりませんか?数が多いと処理が重いと思います。
  • On Error Resume Nextでエラーを無視して、エラーがあった場合の処理を入れています。とりあえず今はエラー内容をそのままセットとしましたが、値がない旨の表示にすべきです。On Error Resume Nextを書くのは本当はもっと上の方がいいと思いますが説明上わかりやすくしています。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2020/07/21 16:29

    propgさん

    >もともと書かれていた`wb.Worksheets("シート名")`にしたらどうなりますか?(読むのはCSVファイルですか?)
    `ON Error Resume Next`とエラー処理を削除かコメントアウトしてください。


    こちら試してみました。
    元々記載したwb.Worksheets("シート名").CSVファイルで行いましたところ、

    実行時エラー1004

    WorksheetFunctionクラスのVlookupプロパティを取得できませんと
    表示されてしまいます。

    Range("A" & i).Formula = Application.WorksheetFunction.VLookup(x, wb.Worksheets("report1594796415383").Range("A1:E10"), 5, False)

    ここでとまってしまうようです。

    キャンセル

  • 2020/07/21 16:39

    シートの指定がうまくいったのでしたら、再度On Error Resume Nextを書いてエラーで止まらないようにします。
    Range("A1:E10")と10行分しか指定していないので見つからないのかもしれません。もとのA:Eに戻したらいかがでしょうか。

    全行が`WorksheetFunctionクラスのVlookupプロパティを取得できません`になるならそもそもVLOOKUPが機能していないと思いますし、何件かは検索されて結果が入っているのであれば、検索キーの問題かと思います。

    キャンセル

  • 2020/07/21 17:06

    propgさん

    こちら試してみたところ、
    処理の反映されました。
    ありがとうございます。

    まだ少し課題はありますが、
    こちらを元に改良していきたいと思います。


    たくさんの方のご支援のおかげで助かりました。
    ほんとにありがとうございます。mm

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.92%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る