マクロでVLOOKUP数式書込　任意ファイルを指定する

Question

お世話になっております。

前回、こちらで下記の質問をさせて頂きました。
https://oshiete.goo.ne.jp/qa/9372398.html

この時は、教えて頂いた方法でイケる！と思っていたのですが
後日確認すると、別ファイルからも数値を参照させていたことが判明しました。
自分で作った集計表なのに、簡単な動作確認しかしておらず
実際使用する時のことを考えていなかったため失念しておりました。
お恥ずかしい限りです。

その後、色々な情報を見て試行錯誤したのですが
やはりVLOOKUPの数式を書き込む際に任意のファイルを指定できるのが
別ファイルの数値を参照する際にも応用できますし
動作として、とても理想的なのですが…
やはりネットの情報だけでは限界があり
また、私自身も勉強不足でマクロのコードを読み解くことが出来ない為
なかなか、いい方法を編み出すことが出来ません。

調べていて、VLOOKUP+INDIRECT関数が理想に近いような気もしたのですが
参照先ファイルを開いていないとエラー値が返ってくるとの事で
別部署で開くことを考えると、ちょっと違うし…と未だ悩んでおります。
そこで、質問タイトルのような動作をさせることが出来るマクロをご教授頂きたく
再度質問させて頂くことにしました。


集計時の条件は以下の通りです。
①ファイルA、ファイルB、ファイルCと３つのファイルが存在し、
　ファイルCはファイルAとファイルBから数値を参照し構成される表です。
　※今回の質問は、このファイルCの集計時に使用するマクロです。
②ファイルAおよびファイルBの数値参照行は毎回変動してしまうため、
　VLOOKUPを使用することを考えました（VLOOKUPに拘りがあるわけではありません）
③ファイルAおよびファイルBは月毎に名称が変更されます。

効率化を考えるなら、ファイルを一纏めにすることが最善なのでしょうが
一つのファイルにシートが沢山あり、その後の業務効率の関係上
ファイルA・B・Cを一つのファイルにすることは出来ません。


前回の質問でも書かせて頂いたように
任意セル（ファイルC）にファイル名を入力後、マクロを実行すると
そのセルにあるファイル名をVLOOKUPで参照引用させる
という動作が理想です。
社内に専門的知識を有する者が居ない為
誰でも操作できるファイルにしたいので、知識も無いくせに欲をかいて申し訳ありません。
マクロじゃ無理という場合は、どういった方法があるか教えて頂ければ幸いです。

ママチャリ · Accepted Answer

お久しぶりです。前回の質問者のママチャリです。
リンクしているファイルが２つあるのであれば、２つ目のリンク先も変更すればいイケるのではないでしょうか。
こんな感じです。

Sub sample()
 With ThisWorkbook
 .ChangeLink Name:=.LinkSources(xlExcelLinks)(1), _
 NewName:=Range("A1"), Type:=xlExcelLinks
 .ChangeLink Name:=.LinkSources(xlExcelLinks)(2), _
 NewName:=Range("A2"), Type:=xlExcelLinks
 End With
 End Sub

上記サンプルは、１番目のリンク先をA１セルで指定したファイル名に。２番目のリンク先をA２セルで指定したファイル名に、それぞれ変更します。

WindFaller · Answer

VBAを本格的に書く者にには、ワークシート関数は、本当に一部のもの以外は、使わないのです。そして、その関数の仕組みを知っていれば、その関数そのものを、VBAで表現しようと試みるというのが、一般的だと思います。

>VLOOKUPと同じように検索値を探しに行く動作を
>マクロのコードで実行させている…というような物なのでしょうか…。

まさしく、そのとおりです。

ワークシート関数は、マッチングというのか、メモリの取り方が違うので、VBAで、ワークシートの関数を使うと、思わぬトラブルが発生することがあります。最終的には、訳の分からないフリーズです。

今、以下の内容を読んでみました。
昔と変わった部分よりも、昔も今も変わらないという印象が強いです。

Excel 2010 のパフォーマンス: パフォーマンスの問題を最適化するヒント
https://msdn.microsoft.com/ja-jp/library/office/ff726673(v=office.14).aspx
で、書かれていて、昔と変わった部分もあるようなのですが、例えば、Index 関数は、マクロでは重要な場面で使うことがあるのは、VBAで使うことを想定されてきた部分があるようです。一度読んだぐらいではさっぱり分からないかもしれません。

簡単に言ってしまうと、揮発性関数と不揮発性関数の違いによって、使い分ける必要も出てくるわけです。VLOOKUPは、揮発性で、なおかつ、並べ替えされたものを想定されているだけ、近似値を求める以外は、使い勝手が劣るというわけです。

むろん、どんなVBAコードよりも速いはずなのですが、思わぬ伏兵として、広い範囲を指定したりする場合、使わなくても、メモリを消費しつづけることがあるようなのです。

WindFaller · Answer

ふつう、マクロ(VBA)は、VBAなのですね。マクロ関数を扱っているわけではありませんから、VlookUpは、しょせん、ワークシート上のものですから、それを工夫すれば、マクロを使わなくても良いような気がします。そんな話をすると、だいたい、この人は何を考えているのだと言われそうですが。
また、マクロ(VBA)は、Convertプログラム(Xdoc2txt.exe)を使えば、10ファイルからでも、100ファイルでも、テキスト検索が可能なのです。

前回の内容、
ActiveCell.Formula = _
"=VLOOKUP(検索値,'①で指定したファイルBのシート1'!$A:$F,6,0)"
VLOOKUPよりも、ずっと繊細できめ細かな検索も可能ですし、ワイルドカードで複数でも、検索してきます。

VLOOKUPをVBA型に移植してみましょう。

>①アクティブファイルAのリストシートのセルA1にデータが載っているファイル名を
>入力

>②ファイルAおよびファイルBの数値参照行は毎回変動してしまうため、
VLOOKUPからすれば、「数値参照行」ではなく、「数値参照列」のはずです。本来、これは、項目行の名前の付け方とか、構成の問題です

もし、その気になったら試してみてください。
データ類は『4行目』に揃えることにしました。

添付の画像の項目の配置です。ボタンは、フォームボタンです。
OPというのはオプションのことで、1または、True で、検索値ひとつを探してきます。False または、何もないと、ABCDE20やABCDE201 などを探します。
パスというのは、ファイルのあるフォルダーのことです。
もうちょっと、スパッと答えが出てくるかと思いましたが、ぼやっとした感じでした。

'//
Sub SearchValueMacro()
　Dim mySh As Worksheet
　Dim c As Range, t As Long
　Dim FirstAddress As String
　Dim sh1 As Worksheet
　Dim serTxt As String '検索値
　Dim Fname As String 'ファイル名
　Dim myRngName As String '範囲名
　Dim myPath As String 'パス名
　Dim myBook As Workbook 'ブック名
　Dim col As Long '検索列
　Dim ShName As String 'シート名
　Dim orgDir As String
　Dim SearOp As Variant, fLookat As Long
　Dim arFound() As Variant, i As Long
　
　Set mySh = ActiveSheet
　'検索オプション　True or 1 全体
　SearOp = Range("G4").Value
　If SearOp = 1 Or SearOp = True Then
　　 fLookat = 1
　Else
　　fLookat = 2
　End If
　t = Cells(Rows.Count, "E").End(xlUp).Row
　If t > 3 Then
　Range("E4", Cells(t, "E")).ClearContents
　End If
　orgDir = ThisWorkbook.Path & "\" '現在は使用していません。
　
　serTxt = Range("A4").Value '検索値
　If serTxt = "" Then MsgBox "検索値がありません。", vbCritical: Exit Sub
　Fname = Range("B4").Value 'ファイル名
　
　'ファイル名を書き入れないと、自分の今のブックになります。
　If Fname = "" Then Set myBook = ThisWorkbook
　
　ShName = "Sheet1" 'シート名
　
　myRngName = Range("C4").Value '範囲
　col = Range("D4").Value
　myPath = Range("F4").Value 'パス
　
　If Right(myPath, 1) = "\" Then myPath = myPath & "\"
　If myPath = "" Then myPath = ThisWorkbook.Path & "\"
　
　If Dir(myPath & Fname) = "" Then
　　MsgBox myPath & Fname & "が見つかりません。", vbExclamation
　　Exit Sub
　End If
　 
'検索プログラム
　Set myBook = Workbooks.Open(myPath & Fname)
　Application.ScreenUpdating = False
　With myBook.Worksheets(ShName).Range(myRngName).Columns(1)
　　Set c = .Find( _
　　What:=serTxt, _
　　LookIn:=xlValues, _
　　LookAt:=fLookat, _
　　SearchOrder:=xlByRows, _
　　MatchCase:=False, _
　　MatchByte:=False)
　　If Not c Is Nothing Then
　　　FirstAddress = c.Address
　　　Do
　　　　ReDim Preserve arFound(i)
　　　　arFound(i) = c.Cells(1, col).Value
　　　　i = i + 1
　　　　Set c = .FindNext(c)
　　　　If c.Address = FirstAddress Then Exit Do
　　　Loop Until c Is Nothing
　　End If
　　myBook.Close False
　　Application.ScreenUpdating = True
　End With
　'書き出し
　If UBound(arFound) >= 0 Then
　　For i = 0 To UBound(arFound)
　　　mySh.Cells(4, "E").Offset(i).Value = arFound(i)
　　Next i
　Else
　　MsgBox "検索しても見つかりませんでした。", vbCritical
　End If
　Set myBook = Nothing
End Sub

tom04 · Answer

こんばんは！

コードを記載しているファイルのSheet1のA1セルに「ファイル名」を入力してあるのですね？

「検索値」なるものが何かが判らないのでインプットボックスを表示させ「検索値」を直接入力する方法にしてみました。
検索ファイルのSheet1のA列に検索値があり、その行のF列データをB15セルに表示させるとしています。

Sub Sample1()
    Dim myPath As String, fN As String, myFn As String
    Dim c As Range, myStr As String, wB As Workbook
        myPath = "保存場所のパス" & "\"
        fN = ThisWorkbook.Worksheets(1).Range("A1") & ".xls*"
        myFn = Dir(myPath & fN)
            If myFn <> "" Then
                myStr = Application.InputBox("検索値を入力")
                Workbooks.Open (myPath & myFn)
                Set wB = ActiveWorkbook
                With ThisWorkbook.Worksheets(1)
                Set c = wB.Worksheets(1).Range("A:A").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        .Range("B15") = c.Offset(, 5)
                    Else
                        MsgBox "該当データなし"
                    End If
                End With
                    Application.DisplayAlerts = False
                        wB.Close
                    Application.DisplayAlerts = True
            Else
                MsgBox "該当ファイルなし"
            End If
End Sub

※　コード内の「保存場所のパス」は
保存場所フォルダのプロパティで確認してください。m(_ _)m

マクロでVLOOKUP数式書込 任意ファイルを指定する

お久しぶりです。

VBAを本格的に書く者にには、ワークシート関数は、本当に一部のもの以外は、使わないのです。

ふつう、マクロ(VBA)は、VBAなのですね。

こんばんは！

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

マクロでVLOOKUP数式書込　任意ファイルを指定する