Excelマクロの処理時間を記録するためのマクロ

これは

Excelマクロの処理時間を記録するために作った、ちょっとしたクラスモジュールです。

やりたかったことは

ちょっと処理時間が長めのExcelマクロを開始したあと、いつ終わるか分からないので放置しておくと、いつの間にか終わっていて、結局どれだけ掛かったのかが分からず、次に流すときにまたやきもきするので、処理時間をログに出すようにしたかったのです。
（それだけのためにパワーかけすぎたという反省を込めて投稿します。）

実行結果イメージ

macroSample.xlsm      Start.       2018/06/10 17:49:37 
macroSample.xlsm      End.         3.00s

こんな感じで、開始時刻と実行時間がイミディエイトウィンドウに出力されます。

使い方

とりあえずこんなふうに処理の先頭に１行書くだけ、って感じにしたかった。

Sub Test1()
    Dim Lap As New Lap: Lap.Start  'この１行を書く

   '以降、通常の処理
    Dim T: T = Timer: Do: DoEvents: Loop Until Timer > T + 3
   '
   '

End Sub

クラスモジュール

用意したのがこちら。
（作成当初に比べ、いくつかおまけの機能が増えている。）

'----Lap.cls----

Option Explicit
Dim mName As String
Dim n As Single, l As Single
Dim mCount As Long, mLapTime As Single, mCollection As New Collection

Sub Start(Optional nm = Null)
    mName = IIf(IsNull(nm), ThisWorkbook.Name, nm)
    Debug.Print mName, "Start.", Now()
    n = Timer
    l = n
End Sub

Private Sub Class_Terminate()
    Debug.Print mName, "End.", Elapsed
    Status
End Sub

Property Get Elapsed(Optional fmt As String = "0.00s") As String
    Elapsed = f(Timer - n, fmt)
End Property

Private Function f(n As Single, fmt As String) As String
    f = Format(n, fmt)
End Function

Function Status(ParamArray str())
    DoEvents
    Status = IIf(UBound(str) = -1, False, Join(str, vbTab))
    Application.StatusBar = Status
End Function

Sub Click()
    mCount = mCount + 1
    mLapTime = Timer - l
    mCollection.Add mLapTime
    Debug.Print vbTab, mCount, LapTime, Elapsed
    l = Timer
End Sub

Property Get Count() As Long
    Count = mCount
End Property

Property Get LapTime(Optional fmt As String = "0.00s") As String
    If mCount > 0 Then LapTime = f(mCollection.Item(mCollection.Count), fmt)
End Property

使い方（おまけ機能）

Sub Test2()
    Dim Lap As New Lap: Lap.Start "test2"   'モジュール名の指定
    With ActiveCell
        .CurrentRegion.ClearContents
        Dim i
        For i = 1 To 500
            If i Mod 100 = 0 Then
                Lap.Click                'ラップタイムの計測
                .Offset(Lap.Count, 0).Value = Lap.Count
                .Offset(Lap.Count, 1).Value = Lap.LapTime
            End If
            Lap.Status i, Lap.Elapsed("0.000")  'ステータスバーに経過を表示
        Next
        .Offset(, 1).Value = Lap.Elapsed
    End With
    MsgBox Lap.Elapsed, , "End"    '処理終了ダイアログで処理時間を表示
End Sub

実行結果（イミディエイトウィンドウ）

test2      Start.        2018/06/10 17:51:31 
             1   1.89s      1.89s
             2   1.70s      3.59s
             3   1.74s      5.33s
             4   1.73s      7.06s
             5   1.70s      8.76s
test2      End.         10.70s