進捗を確認する ② 残り時間を推測する

昨日は何某かの処理状況を、ステータスバーで見える化してみた。
infoment.hatenablog.com
ところで進捗と合わせて、もう一つ知りたいものがある。それは、完了までの残り時間だ。そこで今回は、完了までの残り時間を推測して表示することに挑戦する。

といっても、それほど難しい話ではない。そして難しくない分だけ、精度もさほど高くない。あくまで、目安ということで。

作戦は、こうだ。

1. 全体の10％刻みで、その時点までに掛かった時間を求める。
2. １．で求めた時間から、それまでに処理した１個当たりの平均時間を求める。
3. ２．で求めた平均時間を残りの処理数に乗じて、推定残り時間を算出する。

これを昨日のコードに反映すると、こんな感じになる。

Sub Macro1()
    Dim iMax As Long
        iMax = 2659
    ' 最大値のおおよそ十分の一　※小数点切り上げ
    Dim OneTenth As Long
        OneTenth = iMax / 10 - 1
    ' 進捗度　※10%単位
    Dim Progress As Long
    ' 開始時刻
    Dim StartTime As Single: StartTime = Timer
    ' 経過時間
    Dim ElapsedTime As Single
    ' 平均処理時間
    Dim AverageTime As Single
    ' 推定残り時間
    Dim RemainingTime As Date

    Dim i As Long
        For i = 1 To iMax
            If i Mod OneTenth = 0 Then
                Progress = i / OneTenth
                ' 経過時間
                ElapsedTime = Timer - StartTime
                ' 経過時間内に処理した個数から、１個あたりの平均処理時間を求める｡
                AverageTime = ElapsedTime / i
                ' 処理に必要な残り時間を推測する。
                RemainingTime = TimeSerial(0, 0, (iMax - i) * AverageTime)

                Application.StatusBar = WorksheetFunction.Rept("■", Progress - 1) & _
                                        WorksheetFunction.Rept("□", 10 - Progress + 1) & _
                                        "（全数：" & iMax & " | 推定残り時間： " & RemainingTime & " ）"
                ' １秒の一時停止で、強制的に時間のかかる処理にしている（テスト用）。
                Application.Wait [now()+"0:00:01"]
            End If
        Next
        Application.StatusBar = False
End Sub

動かしてみると、このようになる。

処理数が多くなるほど、平均時間を求めるためのサンプル数が増えるので、精度は上がっていく。だが例えば最後の一つが極端に時間のかかる処理である場合、それまでどれほど現実に近い予測が出来ていたとしても、全く正しくない結果になってしまう。従って、どこまでいっても目安の域を出ない訳だが、割り切ってしまえばそれなりに重宝すると思う。

もう少しだけ続きます。

参考まで。