VBAの作成で困ってます。

質問

VBAの作成で困ってます。

あるフォルダに複数のファイルがあるのですが、
そのファイル名をあるファイル「Ａ」のシートに一覧として作成し、
さらに複数あるファイルのシート「１」のセル「Ａ１」と「Ｃ3」を
作成したファイル名一覧のファイル名のセルの右側に抽出されるようにしようと思っています。
（複数あるファイルの書式は全て統一されています）

ファイル名一覧の作成まではできたのですが、
セルの値の抽出については、
ファイルを一度開いてコピペを繰り返す方法しか（知識が未熟で）作成することができません。。。
しかしこの方法だと時間がかなりかかってしまいます。

ファイルを開くことなく、値だけを抽出してくるにはどうしたらよいでしょうか？

ちなみにファイル名は毎月変わるので、特定のファイルをしてすることはできません。
ファイル名一覧で作成したファイル名をもとに、そのファイルの値を抽出しようと思っています

説明が下手で判りにくかったらすいません。。。

どなたかアドバイスいただけませんでしょうか？よろしくお願いします。

回答No.3

mt2008

Excel4マクロと呼ばれる物を使えばブックを開かずに値を取る事が出来ます。
しかし、Excel4マクロはいつ無くなってもおかしくない古い物ですので、あまりお勧めしません。

Sub Sample1()
　'Excel4マクロ使用
　Dim sPathBookSheet As String
　Application.ScreenUpdating = False
　For i = 1 To 10
　　sPathBookSheet = "'" & ThisWorkbook.Path & "\[" & Range("A" & i).Value & "]1'!"
　　Range("B" & i).Value = ExecuteExcel4Macro(sPathBookSheet & "R1C1")
　　Range("C" & i).Value = ExecuteExcel4Macro(sPathBookSheet & "R1C3")
　Next i
　Application.ScreenUpdating = True
End Sub

普通にブックを開いて値を取っても、やり方によってはそれほど遅くはなりませんよ。
Application.ScreenUpdating　で処理中の画面更新をOFFにして見てください（最後に戻すのを忘れずに）。

Sub Sample2()
　'普通に開く
　Dim Wb As Workbook
　Dim sPathBook As String
　Application.ScreenUpdating = False
　With ThisWorkbook.ActiveSheet
　　For i = 1 To 10
　　　sPathBook = ThisWorkbook.Path & "\" & .Range("A" & i).Value
　　　Set Wb = Workbooks.Open(sPathBook)
　　　.Range("B" & i).Value = Wb.Sheets("1").Range("A1").Value
　　　.Range("C" & i).Value = Wb.Sheets("1").Range("C1").Value
　　　Wb.Close False
　　Next i
　End With
　Application.ScreenUpdating = True
End Sub

回答No.2

layy

とあるフォルダにあるブックすべての１番目シートを作業用ブックの３シート目以降に取り込む、ということはできます。シート２５０個くらいまで可能。ここまで自動化したら後は楽です。終わったら取り込んだシートは削除。１シート目は処理用シート、２シート目はファイル一覧と仮定します。

回答No.1

keithin

「ファイル」ってエクセルブックでいいんですよね。

＞シート「１」の
シート名が「１」という事ですね。
もしも実は不定の名前の１枚目のシートとかだった場合は，ファイル名を拾う際に，一緒にいちいちブックを開いてシート名を確認していくしかありませんが。

sub Macro1()
　dim myFile as string
　dim myPath as string
　dim i
　myPath = "c:\folder\"

　myFile = dir(myPath & "*.xls")
　do until myFile = ""
　　i = i + 1
　　cells(i, "A") = myFile
　　cells(i, "B").formula = "='" & mypath & "[" & myfile & "]1'!A1"
　　cells(i, "C").formula = "='" & mypath & "[" & myfile & "]1'!C3"
　　myFile = dir()
　loop
end sub