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

Question

すいません、、、
教えてください。＞＜

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

Comments

[meg_]

i=0だとエラーが出ませんか？

[tosi]

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

[退会済みユーザー]

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

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

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

[退会済みユーザー]

>繰り返し処理に関してうまく起動せず困っております。
何が起動しないのか追記された方が宜しいかと思います。
また、出来ることであれば、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]

エラーは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)
分解した各行でエラーはでませんか。
先ずは、こちらを通されてから、再度まとめて行います。
この先でのエラーはセル/シートを全然別のところから引いていることが多いです。
別ブックの起動を行い処理していますので、発行するコマンドが適切なシートに対して行っているのか確認する様になるかと思います。

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

Answer 1

いまいちループの作りがよくわかりません。何を基準にループしようとしているのか。。。
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を書くのは本当はもっと上の方がいいと思いますが説明上わかりやすくしています。

Comments

[退会済みユーザー]

EcoDriveさん
少ない情報の中、修正頂きましてありがとうございます。

詳細になるのですが、
あるデータの先月と今月分を参照(Vlookup)し、
先月にあったものはA列に参照され、オートフィルで該当するものと
＃N/Aで表示されるものをVBAで作りたいと思っておりました。

そのためQ列で共通のテーマをキーにしている状態でございます。

こちら試させて頂いたところ、
「インデックスが有効範囲にありません。」
と表示されてしまいます。

再度お手数おかけして申し訳ありませんが
ご教示頂く事は可能でしょうか。

宜しくお願い致します。

[propg]

エラーになるのはどこでしょうか？ wb.Sheets(1)？
エラー発生時は、エラーの場所で止まると思うので、各変数の値がセットされているかどうかウォッチなり、イミディエイトウィンドウで表示してみて確認し、どこで発生しているのか突き止めてください。

もともとのループ処理が正しいのであれば、とりあえずvlookupのエラー処理のみ追加されてみてはいかがでしょうか。
エラーを報告される際は、少なくともどこなのかは提示されたほうが良いです。

[退会済みユーザー]

EcoDriveさん

ご説明ありがとうございます。

マクロの処理は完了するのですが、
セルの値に表示されるのが、
「インデックスが有効範囲にありません。」
こちらとなります。

なので取得されるA列が全部上記の文言で
表示されるといった感じとなります。

説明が不足しており
大変申し訳ございません。。。

[propg]

多分wb.Sheets(1)の1がないんだと思います。
もともと書かれていた`wb.Worksheets("シート名")`にしたらどうなりますか？(読むのはCSVファイルですか？)
`On Error Resume Next`を書いていると、エラーが全部無視されて途中で止まらなくなります。
エラー調査される場合は、`ON Error Resume Next`とエラー処理を削除かコメントアウトしてください。

[退会済みユーザー]

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)

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

[propg]

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

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

[退会済みユーザー]

propgさん

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

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

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