【VBA】高速化

2021年12月28日

そもそもの話

年末年始に引きこもる準備で忙しいjimです。どうも✋

今回は、前回に引き続き『高速化』についてです。

そもそもの話、何で描画やらイベントマクロの停止なんてことをしないといけないかっていうと、Excelを使うからじゃね？Cellを使うからじゃね？っていうね。っていう話よ。

先ず、Cellを使った処理って遅いのね。だから、使えば使うほど処理時間って長くなるわけ。。。

で、殆どの仕事っていうのは過程なんてものはどうでもよくて、最終的に成果物があればよかったりするわけじゃん？

うん。要するに、VBA使えるなら無理してExcel使う必要ないんじゃね？ってこと。

メンテナンス？知らん。個人で作ったマクロなんて、使えなくなったらポイでいいでしょ。

最悪、手動でも効率よくできるようにしておいて、そのマニュアルを残しといたらいい。また誰かが自動化してくれるさ。

配列を使う

例えば、Excelのセル同士で何らかの計算をして、その結果を新しいブックにエクスポート。なんてこと、、、よくありますよね？

以下のコードは新しいブックを開いて、単純に適当な文字列を入力しcsvファイルとして保存するものです。ただし10万行。

Option Explicit
Sub a()
Dim myTime1 As Double
Dim myTime2 As Double
Dim newBook As Workbook
Dim newSheet As Worksheet
Dim i As Long
    Call ExcelEvents(False)
    myTime1 = Timer
    Set newBook = Workbooks.Add
    Set newSheet = newBook.Worksheets(1)
    With newSheet
        .Cells(1, 1) = "No"
        .Cells(1, 2) = "No+1"
        .Cells(1, 3) = "No+2"
        For i = 1 To 100000
            .Cells(i + 1, 1) = i
            .Cells(i + 1, 2) = i + 1
            .Cells(i + 1, 2) = i + 2
        Next
    End With
    newBook.SaveAs fileName:=ThisWorkbook.Path & "\テスト.csv", FileFormat:=xlCSV
    newBook.Close savechanges:=False
    myTime2 = Timer
    Call ExcelEvents(True)
    MsgBox myTime2 - myTime1
End Sub
Private Sub ExcelEvents(ByVal myBoolean As Boolean)
    With Application
        .ScreenUpdating = myBoolean '描画停止
        .EnableEvents = myBoolean 'イベントマクロ停止
        If myBoolean = False Then
            .Calculation = xlCalculationManual '手動計算
            .Cursor = xlWait '砂時計
        Else
            .Calculation = xlCalculationAutomatic '自動計算
            .Cursor = xlDefault 'デフォ矢印
        End If
    End With
End Sub

Excelのイベント類は全て停止させているのにも関わらず。。。

結果は10秒以上かかります。

次は配列を使います。一旦、配列に10万行分の文字列を格納します。その後、一括で配列をシートにエクスポートしてやります。

Option Explicit
Sub b()
Dim myTime1 As Double
Dim myTime2 As Double
Dim newBook As Workbook
Dim newSheet As Worksheet
Dim i As Long
Dim myArr(0 To 100000, 0 To 2) As String
    Call ExcelEvents(False)
    myTime1 = Timer
    Set newBook = Workbooks.Add
    Set newSheet = newBook.Worksheets(1)
    myArr(0, 0) = "No"
    myArr(0, 1) = "No+1"
    myArr(0, 2) = "No+2"
    For i = 1 To 100000
        myArr(i, 0) = i
        myArr(i, 1) = i + 1
        myArr(i, 2) = i + 2
    Next
    newSheet.Range("A1:C" & UBound(myArr, 1) + 1) = myArr()
    newBook.SaveAs fileName:=ThisWorkbook.Path & "\テスト.csv", FileFormat:=xlCSV
    newBook.Close savechanges:=False
    myTime2 = Timer
    Call ExcelEvents(True)
    MsgBox myTime2 - myTime1
End Sub
Private Sub ExcelEvents(ByVal myBoolean As Boolean)
    With Application
        .ScreenUpdating = myBoolean '描画停止
        .EnableEvents = myBoolean 'イベントマクロ停止
        If myBoolean = False Then
            .Calculation = xlCalculationManual '手動計算
            .Cursor = xlWait '砂時計
        Else
            .Calculation = xlCalculationAutomatic '自動計算
            .Cursor = xlDefault 'デフォ矢印
        End If
    End With
End Sub

配列を使っただけなのに、かなり高速化できました。

あまりにも処理時間が長いものは、イベント類を停止させるよりも先に見直さないといけないことがあるかも？

アプリケーションを使わない

そもそもExcelを使わないようにした方が、ダンチのレベチで高速化できる。

Sub c()
Dim myTime1 As Double
Dim myTime2 As Double
Dim csvStr As String
Dim i As Long
    myTime1 = Timer
    Open ThisWorkbook.Path & "\テスト.csv" For Output As #1
    Print #1, "No,No+1,No+2";
    For i = 1 To 100000
        Print #1, vbCrLf & i;
        Print #1, "," & i + 1;
        Print #1, "," & i + 2;
    Next
    Close #1
    myTime2 = Timer
    MsgBox myTime2 - myTime1
End Sub

Excelのイベント類停止なんて意味がないので不要。