ExcelVBAのマルチスレッド化

2018年11月18日2019年10月16日

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

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

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

出力された処理時間は0.1142578秒となりました。

処理時間が大幅に速くなったことがわかると思います。

しかしながらこの処理時間は、実際に10ファイルが出力された時間ではありません。
あくまでVBAの処理が完了した時間のため、実際にファイル出力され終わる時間はこれくらいの処理だとVBAのみの実装と大差ないと思います。
ただ、1ファイルあたり数秒かかる処理であった場合などに、その差は顕著に現れます。

1件あたり10秒かかる処理で考えてみましょう。
シングルスレッドでの実装では1件分処理が終わって次の処理に進むため、処理対象件数×処理時間となります。10件であれば単純計算で100秒です。

それがマルチスレッドであれば、1件目の処理をコールしてすぐ次の処理に進むことができるため、ほぼ1件の処理時間で終わります。
単純計算で10分の1になっており、処理対象件数と1件あたりの処理時間が多ければ多いほど効果が表れます。

最後に

うまく活用することで、かなりのパフォーマンスを得ることができるので高速化で悩んでいる方は一度検討してみるのもよいのではないでしょうか。

Excel VBA, プログラムMultiThread, vba, 高速化

Posted by marimo

WordPressでブログを開設する方法