要はたくさんのExcelファイルから情報を読み込んで1つのシートにまとめるっていう作業がありまして。
そこまでファイル数も大きくないしなー
マクロ組むほどでもないか―
とか思いながら1個1個データを移してたら。。。
意外と時間がかかる！
てか、あとのフォルダの情報量半端ねえ！！
ってことでネット検索♪
先人たちの遺産はネット上にごろごろ転がってるわけですよ。
検索に特化したgoogleさん。
人が質問するワードに近い検索が容易な知恵袋系サービス。
そして一瞬にして問題解決を行ってくれるマクロ♪
おそらく1時間くらいかかりそうな作業が検索・ダウンロード5分。理解10分。実行＆生成で10分くらいで完了しました♪
以下今回使ったソース。
フォーマットの決まったExcelファイルを一括で読み込んでその情報を1つのExcelシートにまとめる。
今回のケースはA1, A2, A3セルに情報が入ってるものとする。
Sub summary()
Sheets.Add
Set nSH = ActiveSheet
rL = 1
Set mySh = CreateObject("Shell.Application")
Set myPath = mySh.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, 0)
If myPath Is Nothing Then Exit Sub
If myPath.Items Is Nothing Then Exit Sub
If myPath.Items.Item Is Nothing Then Exit Sub
フォルダ = myPath.Items.Item.Path
Set mySh = Nothing: Set myPath = Nothing
Set myFS = CreateObject("Scripting.FileSystemObject")
For Each myCSV In myFS.GetFolder(フォルダ).Files
If LCase(myFS.GetExtensionName(myCSV)) = "xls" Then
Workbooks.Open myCSV
'For Each rSH In Sheets
For Each myCC In Range("A1, A2, A3") ' ここに取得したいセルを羅列
rC = rC + 1
nSH.Cells(rL, rC).Value = myCC.Value
Next
rC = rC + 1
nSH.Cells(rL, rC).Value = ActiveWorkbook.Name
rC = rC + 1
nSH.Cells(rL, rC).Value = ActiveSheet.Name
rL = rL + 1
rC = 0
'Next
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
Next
Set myFS = Nothing: Set nSH = Nothing
MsgBox "完了"
End Sub
読めばわかるけどまだVBA慣れてない。。
これも要勉強ですね。
