閉じたままのブックからデータを転記するには？（Tips-12）

「VBAで、閉じたままのブックからデータを転記する方法は無いかにゃー」
と思っている人のために、今回は ExecuteExcel4Macro メソッドを紹介します。

ExecuteExcel4Macro？

それは何かの最先端技術ですか？

いえ、違います。

新しいバージョンの Excel で、 Excel 4.0 時代のマクロ関数を使うことができるメソッドなのです。
PlayStation3 で PlayStation1 のゲームが遊べるようなものです。（←ぇ）

構文は次のとおりです。

f:id:kouten0430:20181226174201j:plain

引数は Excel 4.0 のマクロ関数を等号 (=) なしで指定します。
ゆえに、Excel 4.0 マクロ関数を知らないと使いこなすことができません。

今更、過去のものを覚えてもしょーがないですが、閉じたままのブックからデータを転記できる機能だけでも覚えておいて損はないと思います。

引数は次のとおりです。

ExecuteExcel4Macro("'パス[ファイル名]シート名'!R1C1")

データを取得するセルはR1C1形式で書く必要があります。

んで、指定できるのは1セルのみです。複数範囲からデータを取得するにはループを回すなどの工夫が必要です。

実際にやってみましょう。

まず、1セルのみから。

1データ×500ブック分を転記してみる

下のようにA1セルにデータが入ったものを500ブック用意しました。（ファイル名は 1.xlsx ～ 500.xlsx）

f:id:kouten0430:20181226174524j:plain

ExecuteExcel4Macroメソッドを使って、これ（×500ブック）を転記先ブックの A1～A500 に転記させてみましょう。（処理時間の計測もしておきます）

Sub test1()
    StartTime = Timer

    For i = 1 To 500
        Cells(i, 1) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & i & ".xlsx]Sheet1'!R1C1")
    Next i
    
    Debug.Print Timer - StartTime; "秒"
End Sub

A500までずらーっと転記されました。

f:id:kouten0430:20181226174825j:plain

かかった時間は

f:id:kouten0430:20181226175119j:plain

1.82秒でした。

同じことを、ExecuteExcel4Macro メソッドを使わずにやってみましょう。（1ブックずつ開いて転記する）

Sub test2()
    Application.ScreenUpdating = False

    StartTime = Timer
    
    For i = 1 To 500
        Workbooks.Open Filename:=ThisWorkbook.Path & "\" & i & ".xlsx"
        Cells(i, 1) = Workbooks(i & ".xlsx").Worksheets(1).Cells(1, 1)
        Workbooks(i & ".xlsx").Close savechanges:=False
        DoEvents
    Next i
    
    Debug.Print Timer - StartTime; "秒"
End Sub

かかった時間は

f:id:kouten0430:20181226175348j:plain

174.55秒でした。
さっきの100倍近くかかってしまいました。主にファイルを開いて閉じるのにかかった時間だと推測されます。

5データ×500ブック分を転記してみる

次に、下のように A1～E1 にデータが入ったものを500ブック用意しました。（データがさっきの5倍）

f:id:kouten0430:20181226175527j:plain

ExecuteExcel4Macroメソッドを使って、これ（×500ブック）を転記先ブックの A1～E500 に転記させてみましょう。

Sub test3()
    StartTime = Timer

    For i = 1 To 500
        For j = 1 To 5
            Cells(i, j) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[" & i & ".xlsx]Sheet1'!R1C" & j)
        Next j
    Next i
    
    Debug.Print Timer - StartTime; "秒"
End Sub

E500までずらーっと転記されました。

f:id:kouten0430:20181226175648j:plain

かかった時間は

f:id:kouten0430:20181226175717j:plain
9.59秒でした。

単純に test1 の5倍くらいかかった計算になります。

同じことを、ExecuteExcel4Macro メソッドを使わずにやってみましょう。（1ブックずつ開いて転記する）

Sub test4()
    Application.ScreenUpdating = False

    StartTime = Timer
    
    For i = 1 To 500
        Workbooks.Open Filename:=ThisWorkbook.Path & "\" & i & ".xlsx"
        配列 = Workbooks(i & ".xlsx").Worksheets(1).Range("A1:E1")
        Range(Cells(i, 1), Cells(i, 5)) = 配列
        Workbooks(i & ".xlsx").Close savechanges:=False
        DoEvents
    Next i
    
    Debug.Print Timer - StartTime; "秒"
End Sub

かかった時間は

f:id:kouten0430:20181226175908j:plain
168.21秒でした。