VBAで作ったマクロの高速化②｜エクセルブックを開いたり閉じたりする事自体は速くならないことの対策

VBAによる自動化で時間が掛かる処理の一つにエクセルブックを開く作業と閉じる作業が挙げられます。VBAで自動化する業務はほとんど全て入力データがあり、何かしらの加工を行った上で保存して閉じるという作業である以上、ブックを開いたり閉じたりする作業は避けられません。今回はその部分の高速化を図りたいと思います。

VBAで作ったマクロの高速化②　内部的に開く、閉じる　ではエクセルブックそのものは内部的に開く処理をできないことを解説しました。つまり、エクセルファイルを開いたり閉じたりする事自体を高速化することはできません。

そこで、今回は同じ内容をcsvファイルとして保存しておき、それを取り込む具体的なコードを見ていきたいと思います。

このコンテンツは中級～上級です。
レベルについてはExcel VBAの実力（レベル）を定義してみる　初心者～三段をご参照ください。

VBAで作ったマクロの高速化②改　内部的に開く、閉じる

VBAで作ったマクロの高速化②改　内部的に開く、閉じる

今回のサンプル

今回のサンプルファイルは、ワークブックのA列に日本語のあいさつ、B列にそれに対応する英語のあいさつが100行分記入されています。

５つのファイルはそれぞれSampl1.xlsx、Sample2.xlsx・・・と名付けられています。

具体的な作業内容としては、この5つのエクセルブックを統合して一つのエクセルブックに集約してすると言うものです。

もちろん、実務的には違うファイルを順に開き、それぞれの処理をすると思いますが、今回はエクセルブックを開く場面そのものに焦点を当てています。

普通に開き、一つのファイルとして集約した場合の時間測定

それでは、実際にこの作業を自動化していきましょう。まずは、内部的に開く処理では無く、普通にエクセルブックとして開きます。

Sub 普通にエクセルを開いて一つのブックに集約する()
    
    Debug.Print Time
    
    Const フォルダpath As String = "C:\Users\hoge\" '今回のファイルが保存されているフォルダのパス
    Dim ファイル名temp As String  '取り込むデータを一時的に格納する
    Dim rw As Long '取り込むファイルの最終行を取得する
    Dim wb As Workbook '取り込むファイルを一時的に格納する
    Dim 成果物rw As Long '成果物のファイルの最終行を取得する
    Dim 成果物wb As Workbook '成果物のブックを格納する
    Dim 成果物ws As Worksheet  '成果物のシート
    
    Workbooks.Add  '成果物となるブックを新規作成
    Set 成果物wb = ActiveWorkbook
    Set 成果物ws = ActiveSheet
    
    ファイル名temp = Dir(フォルダpath & "Sample*") '初期設定
    
    Do While ファイル名temp <> ""
        
        If InStr(ファイル名temp, "Sample") <> 0 Then
        
            Workbooks.Open Filename:=フォルダpath & ファイル名temp
            Set wb = ActiveWorkbook
            rw = Cells(Rows.Count, 1).End(xlUp).Row
            
            Range(Cells(1, 1), Cells(rw, 2)).Copy
            成果物ws.Activate
            Range(Cells(成果物rw + 1, 1), Cells(成果物rw + 1 + rw, 2)).PasteSpecial xlPasteValues
            
            Application.CutCopyMode = False 'カットコピーモードを戻す
            
            成果物rw = 成果物rw + 1 + rw '成果物のファイルの最終行を更新
            
            wb.Close SaveChanges:=False '用が済んだら取り込むファイルは閉じておく
            
        End If
        
        ファイル名temp = Dir()
        
    Loop
    
    Debug.Print Time

End Sub

フォルダ内をループして順に開く方法の詳しい解説は、VBA フォルダの中をループで検索して、きょうの日付のファイルを開くをご参照下さい。

5つのファイルを順に開いて転記しては閉じ、を繰り返して掛かった時間は約4秒でした。今回は100行しかないため、それほど時間は掛かりませんでしたが、取り込むファイルが何メガとか、10個以上のファイルとなると許容しがたい時間が掛かってくることになります。

それでは、次に内部的に開いて追記していく手順を見ていきます

csvファイルを内部的に読み取って処理した場合の時間測定

Sub csvをエクセル上に展開せずに開いて一つのブックに集約する()
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'このプロシジャは予め、「まとめ.csv」というファイルを用意しておく必要がある。
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

    Debug.Print Time
    
    Const フォルダpath As String = "C:\Users\XXXX\Documents\blog\" '今回のファイルが保存されているフォルダのパス
    Dim ファイル名temp As String  '取り込むデータを一時的に格納する
    
    ファイル名temp = Dir(フォルダpath & "Sample*") '初期設定

    Open フォルダpath & "まとめ.csv" For Append As #1 'まとめ.csvをエクセル上で無く、開く。ナンバー1として。書き込み用として。
    
    Dim greeting_str As String '一行分を読み込み、書き込む為の一時的な変数
    
　'この外側のループで、フォルダ内の全てのcsvファイルを順に開く
    Do While ファイル名temp <> ""  
        
        If InStr(ファイル名temp, "Sample") <> 0 Then
             　'エクセルブック上で無く、開く。ナンバー2として。読み込み用として。
                Open フォルダpath & ファイル名temp For Input As #2   
                Do Until EOF(2) 'EOFはEnd of File:ファイルの最後の行という意味。このループの中で一つのファイルを最後まで読み込む
                    Line Input #2, greeting_str  '#1を一行読み込んでgreeting_strに格納する
                    Print #1, greeting_str    '#1の末尾にgreeting_strを追加する
                Loop
                Close #2   'SampleX.csvを閉じる      
        End If
        
        ファイル名temp = Dir()
        
    Loop
    
    Close #1 '「まとめ.csv」を閉じる
    
    Debug.Print Time

End Sub