通过 GetTickCount 获取代码运行时间并以特定方式格式化

Question

我正在尝试使 VBA 的 GetTickCount 工作，以便我可以看到代码的运行时间，但它不必非常准确。

以下代码运行良好，但我需要进行一些更改，但不知道如何实现。

#If Win64 Then
    Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
    Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If

' Get first tickcount, start of code
t1 = GetTickCount

'Do stuff here
'#############
'#############
'#############

' Get second tickcount, end of code
t2 = GetTickCount

' Compare tickcounts
If t2 < t1 Then
    ' If t2 is smaller than t1 then the tickcount has been reset, use reset tick value + t2 - t1
    Application.StatusBar = "VBA Code Runtime ms: " & (4294967295# + t2) - t1
Else
    ' If t2 is bigger than t1 then just use t2 - t1
    Application.StatusBar = "VBA Code Runtime ms: " & t2 - t1
End If

我希望运行时以下列方式呈现。

如果运行时间低于 1 秒，则应以毫秒为单位显示。示例：180 milliseconds
如果运行时间低于 1 分钟但超过 1 秒，则应以秒（无毫秒）为单位显示。示例：30 seconds
如果运行时间超过 1 分钟但少于 1 小时，则应以分秒显示。示例：1 minute, 30 seconds
如果运行时间超过 1 小时，则应以小时、分钟和秒显示示例：2 hours, 1 minute, 30 seconds

我将如何实现这一点，任何帮助将不胜感激。

Answer 1

这应该可以为您提供所需的基本结果。

Sub myStopwatch()
    Dim t1 As Double, t2 As Double, et As Double, mssg As String

    Application.StatusBar = "Running..."
    Debug.Print "Start at: " & Time
    t1 = Timer

        ' do stuff here

    t2 = Timer
    Debug.Print "End at: " & Time

    et = t2 - t1 + Abs((t2 < t1) * 86400)
    mssg = "VBA Code Runtime: "
    Select Case et
        Case Is < 1
            mssg = mssg & Format(et, "0.000 \m\s")
        Case 1 To 59.999
            mssg = mssg & Format(Int(et), "0 \s") 'this one rounds down
            'mssg = mssg & Format(et, "0 \s") this one rounds it off up or down
        Case 60 To 3599.999
            mssg = mssg & Format(Int(et / 60), "0 \m\, ") & Format(et Mod 60, "0 \s")
        Case Is >= 3600
            mssg = mssg & Format(Int(et / 3600), "0 \h\, ") & Format(Int((et Mod 3600) / 60), "0 \m\, ") & Format(et Mod 60, "0 \s")
        Case Else
            'do nothing
    End Select

    Application.StatusBar = mssg

End Sub

我使用了 VBA 的内置 Timer 而不是 GetTickCount，因为您最多只需要 10 小时。 Timer 在午夜重置，因此它对延长计时会话没有用。我已经补偿了一次午夜营业额。

如果您对结果不满意，请转到 VBE 的 即时 Window（例如 Ctrl+G）以查看实际的开始和停止时间。

有关 select 案例方法的标准的更多信息，请参见 Select...Case Statement (Visual Basic)。

通过 GetTickCount 获取代码运行时间并以特定方式格式化

Get code runtimes via GetTickCount and format it in specific ways

excel

vba

excel-2007

excel-2013