Googleと知恵袋とVBAがすっごい便利だと思う

完全にルーチンワークな作業が舞い込んできたときにこの3つのツールは本当に便利。


要はたくさんの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慣れてない。。
これも要勉強ですね。