ExcelVBAのマルチスレッド化

2018年11月18日2023年6月17日

Contents

1. はじめに
2. 最終手段である理由
3. 仮想マルチスレッド化の概要
4. 実際の効果
- 4.1. シングルスレッドのソースと実行結果
- 4.2. マルチスレッドのソースと実行結果
5. 最後に

はじめに

Excel VBAで作成された繰り返し処理を行うマクロを高速化する上で、最終手段ともいえるマルチスレッド化を紹介したいと思います。
高速化したい動作や処理によっては実装できない場合もあるので注意してください。

最終手段である理由

繰り返し処理の高速化を行いたいと思った際、最初からマルチスレッド化する必要なんてありません。
まずは、簡単に実装できる描画停止や自動計算停止を行うべきです。意外とこの基本的な部分で処理速度は大幅に向上します。
その後、実行速度に納得がいかない場合、プログラムの見直しを行います。
それでもなお、実行速度に納得がいかない場合に、仮想マルチスレッド化を検討するのが良いと思います。
なぜなら開発コストが他の高速化手法に比べて段違いに高いからです。しかしながら、その分効果も大きいのでやり甲斐はあると思います。

仮想マルチスレッド化の概要

繰り返し処理部分をVBScriptへ移植し、VBA側からは移植後のスクリプトをコールするのみとします。
VBScriptの処理が終わっていなくても次のコールができるので処理時間が大幅に軽減されるという仕組みです。

実際の効果

文字だけで説明してもわかりにくいのでサンプルを作成して処理時間を計測してみました。
表中のパスに新規のExcelファイルを保存していくマクロです。

シングルスレッドのソースと実行結果

以下がソースです。

Sub single_thread()

    Dim i As Long
    Dim startTime As Single
    Dim endTime As Single
    Dim wkBook As Workbook

    With Application
        .ScreenUpdating = False
        .EnableAnimations = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    '処理時間計測用（始点）'
    startTime = Timer

    i = 6

    With ThisWorkbook.Worksheets("Sheet1")

        'Noが存在し続ける限り処理継続'
        Do While .Range("B" & i).Value <> ""

            'Bookを作成'
            Set wkBook = Workbooks.Add
            'Bookを保存'
            wkBook.SaveAs Filename:=.Range("C" & i).Value & Application.PathSeparator & .Range("D" & i).Value & ".xlsx"
            'Bookを閉じる'
            wkBook.Close
            '次の行へ'
            i = i + 1

        Loop

    End With

    '処理時間計測用（終点）'
    endTime = Timer

    With Application
        .ScreenUpdating = True
        .EnableAnimations = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

    '処理時間表示'
    MsgBox "処理時間：" & endTime - startTime & "秒"

End Sub

上記プログラムにて、出力された処理時間は4.886719秒となりました。

10ファイル作成するのに5秒弱かかりました。

マルチスレッドのソースと実行結果

以下がソースです。
ループで行っていた処理をVBScriptに移植しています。今回はVBAからVBScriptを生成するようにしています。

Sub multi_thread()

    Dim i As Long
    Dim startTime As Single
    Dim endTime As Single

    Dim fso As Object
    Dim vbs As Object

    With Application
        .ScreenUpdating = False
        .EnableAnimations = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    '処理時間計測用（始点）'
    startTime = Timer

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set vbs = fso.CreateTextFile( _
              Filename:=ThisWorkbook.Path & "\ExcelCreate.vbs", _
              overwrite:=True, _
              Unicode:=False)

    'Book作成→保存→閉じる処理をvbsに移植'
    With vbs

        .WriteLine (" Dim outPath")
        .WriteLine (" Dim app")
        .WriteLine (" Dim wkBook")
        .WriteLine (" outPath = WScript.Arguments.Item(0)")
        .WriteLine (" Set app = CreateObject(""Excel.Application"")")
        .WriteLine (" app.Workbooks.Add")
        .WriteLine (" Set wkBook = app.Workbooks(app.Workbooks.Count)")
        .WriteLine (" wkBook.SaveAs(outPath)")
        .WriteLine (" wkBook.Close")
        .WriteLine (" app.Quit")
        .WriteLine ("")
        .Close

    End With

    i = 6

    With ThisWorkbook.Worksheets("Sheet1")

        'Noが存在し続ける限り処理継続'
        Do While .Range("B" & i).Value <> ""

            '作成したvbsをコール'
            Shell "WScript.exe " _
                  & ThisWorkbook.Path & "\ExcelCreate.vbs " _
                  & .Range("C" & i).Value & Application.PathSeparator & .Range("D" & i).Value & ".xlsx"
            '次の行へ'
            i = i + 1
        Loop

    End With

    '処理時間計測用（終点）'
    endTime = Timer

    With Application
        .ScreenUpdating = True
        .EnableAnimations = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

    '処理時間表示'
    MsgBox "処理時間：" & endTime - startTime & "秒"

End Sub