ExcelVBAにて時間がかかる処理を行う場合に、簡易的に途中経過を出す方法を解説いたします。
方法
Application.StatusBar = (表示したい文字列)
実行結果

参考までに・・・
もちろん、こんな感じでグラフィカルな物(プログレスバー)も作れますが、今回は簡易的に手っ取り早く済ませる方法として、「Application.StatusBar」というのをご説明します。

サンプル
プログラミングの初歩の問題でよく扱われる「FizzBuzz問題」を、1~10万まで出力するプログラムを作って、説明していきます。
(このくらいならExcelのワークシート関数で出来ますし、今どきのパソコンなら途中経過を出すまでもなく数秒で終わりますが、簡単なサンプルということで・・・)
1から順に数を数えていき、以下のように発言していくゲームです。
・3の倍数なら「Fizz」
・5の倍数なら「Buzz」
・両方の倍数(すなわち15の倍数)なら「Fizz Buzz」
・いずれでもなければその数を言う
元々は海外の言葉遊びで、そのルールをプログラムに実装したものです。
コーディング例
Sub FizzBuzz()
Dim Idx1 As Long
For Idx1 = 1 To 100000
'A列:数字を表示
Sheets("Sheet1").Cells(Idx1, 1) = Idx1
'B列:FizzBussの答えを表示
If Idx1 Mod 3 = 0 And Idx1 Mod 5 = 0 Then
Sheets("Sheet1").Cells(Idx1, 2) = "Fizz Buzz"
ElseIf Idx1 Mod 3 = 0 Then
Sheets("Sheet1").Cells(Idx1, 2) = "Fizz"
ElseIf Idx1 Mod 5 = 0 Then
Sheets("Sheet1").Cells(Idx1, 2) = "Buzz"
Else
Sheets("Sheet1").Cells(Idx1, 2) = Idx1
End If
'数字が1万の倍数の場合は、途中経過を表示
If Idx1 Mod 10000 = 0 Then
Application.StatusBar = Idx1 & "行目 処理中 " & Time
End If
Next
'↓これを忘れると、処理終了後も途中経過が表示されたままになるので注意!
Application.StatusBar = False
End Sub
実行結果

解説
処理中の以下の部分で、当記事の先頭に載せたように、途中経過(数字と処理時刻)を表示しています。
今回は「1万行ごと」(1万の倍数のとき)に表示しましたが、このように条件をつけないと、描画に時間がかかって処理が遅くなるので、気を付けて下さい。
また、途中経過の表示間隔が長すぎると、本当に処理が進んでいるか、不安を与えることになりますので、実際に試しながら「表示間隔は長すぎず短すぎず」というバランスを考える必要があります。
If Idx1 Mod 10000 = 0 Then
Application.StatusBar = Idx1 & "行目 処理中 " & Time
End If
また、コーディング例のコメントにも書きましたが、処理終了後に以下の1文を忘れると、途中経過が表示されたまま残ってしまいますので、忘れないようにして下さい。
Application.StatusBar = False
補足
高速化のために「Application.ScreenUpdating = False」を入れて描画を止めていると、今回の方法では途中結果が表示されない場合があります。
そんな場合は、以下のような工夫をする必要があります。
Application.ScreenUpdating = True ‘ScreenUpdatingをTrueに戻す
Application.StatusBar = Idx1 & "行目 処理中 " & Time
DoEvents ‘制御をOSに戻す
Application.ScreenUpdating = False ‘ScreenUpdatingをFalseに戻す
コメント