VBA実行中にExcelが使えないのが嫌なので解決方法を考える

2022-01-28

多分これが原因でVBA避ける人も多いんじゃないですかね。
VBA、すぐに重くなるのに処理中はExcelが使えなくなってしまうので超絶不便。
複数プロセス立ち上げればなんとかはなるんですけど、それはそれで面倒くさい。

今回はこのExcelが使えない時間を減らすための対策を考えてみます。

処理概要

VBA→PowerShell→VBA

ただこれだけ。最初にVBAからCSVを出力して、それをPowerShellで処理する。
PowerShellの処理が完了したらCSV取り込み用のVBAを実行できるようにする。

結局VBAを呼び出している間はExcel上で作業したくないので、他の言語を呼び出してVBAの実行時間を極力避けるというのが今回の作戦になります。

実行画面

実行用のボタンは3つ。あとVisibleをfalseに設定しているテキストボックスが1つ存在しています。

Excel上の個人情報っぽいデータは下記のサイトで作成したダミーデータなのでご安心を。

主にアプリケーションの開発/試験の際のテストデータとしての使用を目的とした、架空の個人情報データ(疑似個人情報)を生成するサービスです。
hogehoge.tk

各ボタンの処理概要

処理開始ボタン

これは処理を開始するためのボタンになります。

マクロ実行シートのデータをCSVとしてローカルに保存してから、PowerShellを呼び出す処理までを担います。

処理が終わったか確認!ボタン

これは処理開始ボタンを押したときに出力したファイルの更新日時が更新されたかどうかを確認するボタンです。

処理開始ボタンで作成したCSVの最初の更新日時(比較対象)は見えないテキストボックスに保存しています。

結果を取り込みボタン

新しいシートを作成してPowerShellから出力したCSVを取込ます。

テキストボックス(見えない)

処理開始ボタンで作成したCSVの最初の更新日時を保存します。
CSVの更新日時が変わったかどうか確認するために使用します。

問題点

VBAとPowerShellを完全に切り離しているので、PowerShellでエラーが発生していてもVBA側ではエラーを検知できない。

実際のコード(一部抜粋)

VBA部分

Dim fso As FileSystemObject

'処理開始ボタンに割り当てている処理
Sub OutputCsv()
    Application.DisplayAlerts = False
    
    Dim varFile As Variant
    varFile = ActiveWorkbook.Path + "\" + ActiveWorkbook.name + "_tmp"
    If varFile = False Then
        Exit Sub
    End If
    
    ActiveSheet.Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=varFile, FileFormat:=xlCSV, CreateBackup:=False
    ActiveWindow.Close
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    Dim f As File
    Set f = fso.GetFile(ActiveWorkbook.Path + "\" + ActiveWorkbook.name + "_tmp")
    
    Dim d As Date
    d = f.DateLastModified
    
    'TextBox1=テキストボックス(見えない)
    ActiveSheet.TextBox1.Value = Format(d, "yyyymmddhhmmss")
        
    Dim objExec As Object
    Set objExec = CreateObject("WScript.Shell")
    objExec.Run "powershell -NoProfile -ExecutionPolicy Unrestricted " & ActiveWorkbook.Path & "\vba.ps1", 0, False
    
    Application.DisplayAlerts = True
End Sub

'処理が終わったか確認!ボタンに割り当てている処理
Sub checkCsv()    
    Set fso = New FileSystemObject
    
    Dim f As File
    Set f = fso.GetFile(ActiveWorkbook.name + "_tmp")
    
    Dim d As Date
    d = f.DateLastModified

    If (ActiveSheet.TextBox1.Value < Format(d, "yyyymmddhhmmss")) Then
        MsgBox "処理が終了しました。"
    Else
        MsgBox "もうしばらくお待ちください。"
    End If
End Sub

'結果を取り込みボタンに割り当てている処理
Sub getResult()
    file_name = ActiveWorkbook.name
    
    Call Workbooks.OpenText(ActiveWorkbook.Path + "\" + file_name + "_tmp", Origin:=932, Comma:=True)
    
    Worksheets(1).Copy After:=Workbooks(file_name).Worksheets("マクロ実行")
    Workbooks(file_name + "_tmp").Close
    
    Set fso = New FileSystemObject

    Call fso.DeleteFile(ActiveWorkbook.Path + "\" + file_name + "_tmp", True)
End Sub

この他にもどの処理まで実行したか判定したりボタンの色を変えたりしていますがそれは今回のメイン処理ではないので省略しています。

あと保存するCSVですがExcelのマクロから作成された一時ファイルなことが分かりやすいように「[マクロ実行ブック名]_tmp」となるようにしています。

PowerShell部分

$path = "./sakusaku_jikkou.xlsm_tmp"

#更新日時が確実に変わるように1秒待機
Start-Sleep -s 1

$csv = Import-Csv $path -Encoding Default


#CSVに対する何かしらの処理を書く(サンプルは10秒待機)
Start-Sleep -s 10

$csv | Export-Csv $path -NoTypeInformation -Encoding Default

今回は重い処理を疑似的に表現しています。

実際に使用する場合は10行目の「Start-Sleep -s 10」の部分にCSVに対して実行したい処理を記載ください。

サンプルファイルダウンロード

以下(有料になります)で今回作成したファイルのダウンロードが可能です。

実行環境

Windows 10 Pro(バージョン20H2)
Microsoft® Excel® for Microsoft 365 MSO (バージョン 2112 ビルド 16.0.14729.20254) 64 ビット