ブックを開かずに、フォルダ内にある複数ブックの、特定セルの値を抽出した

質問

ブックを開かずに、フォルダ内にある複数ブックの、特定セルの値を抽出したいのですが、やり方をご存じの方がいらっしゃったら教えてください。

フォルダ内には150個ほどエクセルファイルがあり、中身のシート名・フォーマットは同じなのですが、すべてファイル名が違います。
ファイルを開くことなく、これらのファイルの特定のシートの特定のセルにある値を、全て1枚の表にまとめることは可能でしょうか？

フォルダ名　→"AGENDA_RIREKI"
参照したいファイル名 →ファイルによって異なる "#1111 AAA.xls"など
参照したいシート名→　"AGENDA"
参照したいセル→　"A7" と "E20～E70（E列のみ）

データをまとめたいファイル名→ "AGENDA_matome.xls"
データをまとめる時の形↓

（A列）　　　　　　　　　　（B列）　　　　　　　　　　　　（C列）　　　　　　　　（D列）
ファイル１のA7の値　ファイル１のE20の値　　ファイル２のA7の値　　ファイル２のE20の値
　　　　　　　　　　　　　　　　　　　　E21の値　　　 　　　　　　　　　　　　　　　　E21の値
　　　　　　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　　　　　　・

VBAは初心者です。。できればコードをそのまま拝借したいです。
お知恵を貸してください。よろしくお願いします。

回答No.3

mitarashi

#1でご紹介のあったExecuteExcel4Macroで遊んでみました。
ファイル名、シート名、アドレスを指定して、値をVariant型変数に取得し、セルに貼付ます。
こんな事をやるより、#2の様に処理する方がきっと速いと思います。
なお、VarTypeで分岐して処理しないと、001→1、日付→シリアル値になってしまうといった問題があり、深みにはまってしまいます。（そこまでは対策していません）
Sub test()
Dim rtnVariant As Variant
Dim destRange As Range

Set destRange = ActiveSheet.Range("A1") '読んだ値（一個または複数）をA1から貼り付ける場合
rtnVariant = readDatas("c:\hoge.xls", "Sheet1", "A1:D1")
If IsArray(rtnVariant) Then
Set destRange = destRange.Resize(UBound(rtnVariant, 1), UBound(rtnVariant, 2))
destRange = rtnVariant
Else
destRange.Value = rtnVariant
End If
End Sub
'Activesheetのセル範囲をVariant配列生成と、アドレス変換用に使用してみました（中味の値はいじらない）
Function readDatas(wbFullpath As String, sheetName As String, addressA1 As String) As Variant
Dim argString As String
Dim myPath As String
Dim buf As Variant
Dim i As Long, j As Long

On Error GoTo errorHandle
myPath = "'" & Left(wbFullpath, InStrRev(wbFullpath, "\"))
myPath = myPath & "[" & Mid(wbFullpath, InStrRev(wbFullpath, "\") + 1, Len(wbFullpath)) & "]"
myPath = myPath & sheetName & "'!"
With ActiveSheet
If .Range(addressA1).Cells.Count > 1 Then
buf = .Range(addressA1)
With .Range(addressA1)
For i = 1 To UBound(buf, 1)
For j = 1 To UBound(buf, 2)
argString = myPath & .Cells(i, j).Address(ReferenceStyle:=xlR1C1)
buf(i, j) = ExecuteExcel4Macro(argString)
Next j
Next i
End With
Else
argString = myPath & .Range(addressA1).Address(ReferenceStyle:=xlR1C1)
buf = ExecuteExcel4Macro(argString)
End If
End With
readDatas = buf
Exit Function
errorHandle:
'2023 ファイルまたはシートが見つからない
readDatas = Err.Number & " " & Err.Description
End Function

回答No.2

end-u

Application.ScreenUpdatingで画面更新を制御できますから
開いている事を感じさせないようにする事は可能です。

'標準モジュールに。
Option Explicit
Sub try_1()
　　Const path = "C:\AGENDA_RIREKI\"
　　Const sname = "AGENDA"
　　Dim fname As String
　　Dim ws　　As Worksheet
　　Dim i　　 As Long

　　'画面更新停止。開くところを見せない。
　　Application.ScreenUpdating = False
　　Set ws = Sheets.Add
　　i = 1
　　'Dir関数を使って該当フォルダをLoop
　　fname = Dir(path & "*.xls")
　　Do Until Len(fname) = 0
　　　　If fname <> ThisWorkbook.Name Then
　　　　　　With Workbooks.Open(Filename:=path & fname, _
　　　　　　　　　　　　　　　　UpdateLinks:=0, _
　　　　　　　　　　　　　　　　ReadOnly:=True)
　　　　　　　　With .Sheets(sname)
　　　　　　　　　　ws.Cells(1, i).Value = .Range("A7").Value
　　　　　　　　　　ws.Cells(1, i + 1).Resize(51).Value = .Range("E20:E70").Value
　　　　　　　　End With
　　　　　　　　.Close savechanges:=False
　　　　　　End With
　　　　　　'次の書き出し位置
　　　　　　i = i + 2
　　　　　　'列オーバーなら新規Sheetへ
　　　　　　If i > ws.Columns.Count Then
　　　　　　　　i = 1
　　　　　　　　Set ws = Sheets.Add
　　　　　　End If
　　　　End If
　　　　fname = Dir()
　　Loop
　　Set ws = Nothing
　　Application.ScreenUpdating = True
End Sub

Dir関数を使ったLoop処理について勉強してください。
Bookオープン等の処理はマクロ記録なども参考に。

また、速度を上げたいなら参照数式をセットして値化すれば良いです。
Sub try_2()
　　Const path = "C:\AGENDA_RIREKI\"
　　Const sname = "AGENDA"
　　Dim fname As String
　　Dim i　　 As Long

　　Sheets.Add
　　i = 1
　　fname = Dir(path & "*.xls")
　　Do Until Len(fname) = 0
　　　　If fname <> ThisWorkbook.Name Then
　　　　　　With Cells(1, i)
　　　　　　　　'='C:\AGENDA_RIREKI\[Book1.xls]AGENDA'!A7..みたいな式
　　　　　　　　.Formula = "='" & path & "[" & fname & "]" & sname & "'!A7"
　　　　　　　　'値化
　　　　　　　　.Value = .Value
　　　　　　End With
　　　　　　With Cells(1, i + 1).Resize(51)
　　　　　　　　.Formula = "='" & path & "[" & fname & "]" & sname & "'!E20"
　　　　　　　　.Value = .Value
　　　　　　End With
　　　　　　i = i + 2
　　　　　　If i > Columns.Count Then
　　　　　　　　Sheets.Add
　　　　　　　　i = 1
　　　　　　End If
　　　　End If
　　　　fname = Dir()
　　Loop
End Sub

回答No.1

imogasi

他の質問異も書いたがことだが、
基本的にソフトで作られたデータは、そのソフトで開かなければ、内容を読めません。コンピュターのメモリにないデータは、読めないのがコンピュターの鉄則です。エクセルでもそんな開かないでデータを採るなんて、素人は考えないこと。えてして良くわかってない人が出来るのではないかと幻想を抱く。（Ｅxcel4.0マクロと言うものに、これの例外と思しきことが出てくるが、これも画面に表示しないが、メモリに保存データを展開して、必要なデータ部分を割り出していると思われる。これは専門家ならではで出来ること、フォーマットがわかっている人に出来るこで、ＶＢＡを始めたぐらいの人には不可能）
ーー
ブックを開く
読むー＞でーた（情報）をとるー＞書き出す
クロズする
個の繰り返し。
迷わずやること。
それがイヤなら初めからそういうデータ項目だけをし集約しファイルをつくることだ。
データベース化してそういうことはやっている。　　勉強してください。
エクセルごときでやろうとするから時間がかかるのだ。
データベースで検索が早いのは、それまでに仕組みの構築に時間と手間をかけているからだ。