えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

ExcelVBAを疑似マルチスレッド化してみる

今回はExcelのみでExcelVBAを疑似マルチスレッド化できるかの実験をします。

f:id:Kotori-ChunChun:20190327005013p:plain


きっかけ

最近(私の中で)話題のExcel作曲家こと「あっさん」がこんなツイートをしていました。

ExcelVBAからVBSへ処理を投げることで疑似マルチスレッド化(実際にはマルチプロセス化)することが可能なのは一部では有名な話です。

でもVBSだとデバッグしずらいし、Win32APIが使えないので不便だなぁと以前から思ってはいました。

ところが今日は天才的なひらめきをしたので、早速かたちにしてみることに。

でもWorkbook_Openイベントに書くと親子の判別が出来ないので、若干変更しました。

コード

Option Explicit

'親部分
Sub Main()
    Const MAX_PROCESS = 10

    Dim Apps As Collection:    Set Apps = New Collection
    Dim i As Long
    
    '下準備
    Dim App As Excel.Application
    Dim Wb As Workbook
    
    For i = 1 To MAX_PROCESS
        '別インスタンスのExcelを起動
        Set App = New Application
        Apps.Add App
        
        '自分と同じファイルを大量に降臨させる
        Set Wb = App.Workbooks.Open(ThisWorkbook.FullName, _
                                    UpdateLinks:=False, _
                                    ReadOnly:=True)
        
        '子プロセスに司令を出す。
            '※この時呼ばれるプロシージャにはOnTimeのみを
            '記述し直ちに応答を返さなければならない。
        App.Run "'" & Wb.Name & "'!ExecSubMacro", i
        
        DoEvents
    Next
    
    Set App = Nothing
    Set Wb = Nothing
    
    '子プロセスの終了待ち : とりあえずWorkbookの数で判断する。
    For i = 1 To Apps.Count
ContinueFor:
        If Apps(i).Workbooks.Count > 0 Then
            Application.Wait [Now() + "00:00:00.2"]
            DoEvents
            'Debug.Print "Not Closed : "; i
            GoTo ContinueFor
        End If
    Next
    
    '子Excelのインスタンスの破棄
    'これをサボるとEXCEL.EXEがゾンビ化するかもしれない。
    On Error Resume Next
    For i = 1 To Apps.Count
        Apps(1).Quit
        Apps.Remove 1
    Next
    On Error GoTo 0
    
    MsgBox "完了!"
End Sub

'SubMacroを別のスレッドで実行させる。
'本プロシージャは呼び出し元に直ちに制御を返さなければならない。
Sub ExecSubMacro(n As Long)
    'OnTimeはThisWorkbookプロセスのスレッドでの呼び出しになる。
    Application.OnTime [Now() + "00:00:00.2"], "'SubMacro """ & n & """'"
End Sub

'時間のかかる処理
Sub SubMacro(n As Long)
    
    '適当に重い処理をする。:WaitはCPUをバカ食いするので採用
    '本当に実行されたことを確認するため、同フォルダにテキストファイルを出力する。
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim ts As TextStream: Set ts = fso.CreateTextFile(ThisWorkbook.Path & "\" & n & ".txt")
    Dim i As Long
    For i = 1 To 10
        ts.WriteLine Format(Now(), "yyyy/mm/dd hh:mm:ss") & " " & i
        Application.Wait [Now() + "00:00:01"]
    Next
    ts.Close
    Set ts = Nothing
    
    'ブックを閉じることが処理終了の合図とする。
    Application.DisplayAlerts = False
    ThisWorkbook.Close False
    
    '親VBAが捕まえているため、このQuitは無視される気配
    Application.Quit
End Sub

結果

全てのコア(スレッド)が軒並み上昇しているので、マルチプロセス化には成功していると思う。

ちゃんとした処理を書けばマルチコアCPUを使っているPCでは大幅に高速化できるようになるハズです。

f:id:Kotori-ChunChun:20190327005110p:plain

f:id:Kotori-ChunChun:20190327005105p:plain

詳しい解説は省略するのでコメントを参考にどうぞ。

ちょっとだけ解説

今回のキモはApplication.OnTimeです。

OnTimeは「指定した時刻になったら任意のプロシージャを実行する」という機能があります。

今回の例では「ExecSubMacro」はメインスレッドから呼び出しているので、処理が終わるまでメインスレッド(親プロセス)はその間実行が止まりますが、OnTimeを実行してすぐに制御を返しているため殆どロスがありません。

対して「SubMacro」はOnTimeの予約から実行されるため、子プロセスのExcelが自分で考えて実行するのです。つまり、スレッドが分離するのです。

あとはExcelをドンドン起動させて行くだけで、マルチコア対応VBAの完成です。

(分担した処理を収集して一本化する作業が大変かもしれませんが)

OnTimeは通常の方法ではどうしようもない時の秘密兵器として用いることが稀にあります。興味のある人は色々と使ってみてください。

まとめ

VBSを使わなくても、Excelだけでマルチプロセス化は出来る!

但しメインスレッド上でロスの大きいNew Applicationを行わなければならないので、下準備には少々時間がかかる。

(そもそもマルチプロセス化したいときは、膨大な時間のかかる処理のはずなので、無視出来る程度の負荷だと思う)

以上


何か御座いましたらコメント欄、またはTwitterからどうぞ♪

週1回の更新を目指して、頑張ってますので応援よろしくおねがいします!

それでは、また今度♪ ちゅんちゅん(・8・)