ExcelのVBAで繰り返し計算させるときに、進捗度をステータスバーに表示させています。
ループのカウンターやトータルの回数を表示させたり、
長い計算の時は、計算し終わった分の一回当たりの処理時間を求めて、
それに残り回数をかければ、あとどれぐらいで処理が終わるかの推定ができますから
それも合わせて表示させたりしています。
しかし、トータルの回数は多いけれども、一回の処理時間が短い時に、
毎回ステータスバーの表示を更新していると、処理が遅くなります。
理由は「ステータスバーに表示するから」です。
進捗を知るために、結果的に処理速度を落としては意味がありません。
そこで、ステータスバーに表示する回数の目安を調べました。
まず、ステータスバーに何かを表示するのにかかる時間です。
下のマクロを実行して時間を調べました。（あくまで私のパソコンでの時間です。）
結果は、約2ミリ秒でした。
ある繰り返し処理で、一回の処理に Xミリ秒かかるときに、
毎回ステータスバーに何かを表示すると、（X+2）/X = 1 + 2/X に処理時間が伸びます。
そこで、ｎ回に一度ステータスバーに表示をすれば 1 + 2/(X*n) の処理時間に伸びます。
どれぐらい伸びても良いか、どれぐらいの間隔で表示したいのか、
でｎを決めればよいことになります。
ただ、これだと目的の処理時間Xを知っていないといけません。
そこで、ステータスバーに何か表示をするときに、Y秒おきにしか表示しないとすれば
目的の処理時間はとりあえず考えなくてよいことになります。この場合は、
（Y+2）/Y = 1 + 2/Y に処理時間が伸びます。
Yを１秒にとれば 0.2％の増加、
0.5秒にとれば0.4%の増加、
0.2秒にすれば1%の増加になります。
0.5秒ごとぐらいで表示が更新されるのなら、
進捗の確認としても許せる気がします。
マクロとしては
ステータスバーに表示する時に、
「前に表示した時刻との差がY秒を超えていれば表示する」、
ということにすればよいことになります。
空文字を引数にするとステータスバーの表示をリセットするようにもするとよさそうです。
以上から、プロシジャー Function StbMsg を作りました。
main3のように呼び出して使います。
Function StbMsg(Optional msg As Variant = "", Optional sec As Double = 0.5) As Variant
Static LastTimer As Double
Dim NowTimer As Double
With Application
If msg <> "" Then
NowTimer = Timer
If Abs(LastTimer - NowTimer) >= sec Then
.StatusBar = msg
LastTimer = NowTimer
End If
Else
.StatusBar = False
End If
StbMsg = .StatusBar
End With
End Function
●ステータスバーに何かを表示するのにかかる時間
１．ループを100万回まわすと、0.00390625 秒でした（main1）。
２．ステータスバーに100回表示させると、0.1953125 秒でした（main2）。
３．よってステータスバーに一回表示させると、2ミリ秒（0.00195=0.1953125/100 - 0.0039/1000000)かかります。
Sub main1()
Dim i As Long, n As Long
Dim t1 As Double, t2 As Double
n = 1000000
t1 = Timer
For i = 1 To n
'何もしない
Next i
t2 = Timer
Debug.Print t2 - t1
End Sub
Sub main2()
Dim i As Long, n As Long
Dim t1 As Double, t2 As Double
n = 100
t1 = Timer
For i = 1 To n
Application.StatusBar = i & "/" & n
Next i
Application.StatusBar = False
t2 = Timer
Debug.Print t2 - t1
End Sub
Sub main3()
Dim i As Long, n As Long
Dim t1 As Double, t2 As Double
n = 1000000
t1 = Timer
For i = 1 To n
StbMsg i & "/" & n, 0.8
Next i
StbMsg
t2 = Timer
Debug.Print t2 - t1
End Sub