excel - 在 API GetSystemTime 中使用经过的毫秒数进行性能测试

Question

任务

我正在做一些性能测试，测量开始时间 (st1) 和结束时间 (st1) 之间耗时。因为我还想显示毫秒，所以我正在使用 API 函数 GetSystemTime:

GetSystemTime st1   ' get start time as system time
GetSystemTime st2   ' get end   time as system time

问题

简单的减法是不可能的

st2 - st1

，因为这会导致错误 13 消息。到目前为止，我没有找到任何解决方案，但成功创建了一个简单的解决方法 SystemTimeDiff(st1 As SYSTEMTIME, st2 As SYSTEMTIME)。

问题

我想知道是否存在更简单的方法或 SystemTimeDiff 函数 - 例如与 DateDiff 相当？

代码

Option Explicit

' API Declaration
Private Declare Sub GetSystemTime Lib "kernel32" ( _
        lpSystemTime As SYSTEMTIME)

Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

' ================
' Performance Test
' ================
Sub TestSystemTimeDifference()
  Dim st1       As SYSTEMTIME
  Dim st2       As SYSTEMTIME
  GetSystemTime st1     ' Start time

  ' Do something
  ' ............

  GetSystemTime st2     ' End time

' ================
  ' Show System time elapsed with milliseconds as work around
' ================
  MsgBox SystemTimeDiff(st1, st2), vbInformation, "Systemtime elapsed"

End Sub


' ==============
' My Work around
' ==============
Function SystemTimeDiff(st1 As SYSTEMTIME, st2 As SYSTEMTIME)
  Dim msec1     As Integer: Dim msec2 As Integer
  Dim timetaken As Date
  msec1 = Val(Left(Split(FormatSystemTime(st1) & ".", ".")(1) & "000", 3))
  msec2 = Val(Left(Split(FormatSystemTime(st2) & ".", ".")(1) & "000", 3))
  If msec2 < msec1 Then msec2 = msec2 + 1000
  timetaken = CDate(Split(FormatSystemTime(st2) & ".", ".")(0)) - CDate(Split(FormatSystemTime(st1), ".")(0))
  SystemTimeDiff = FormatSystemTime(st1) & vbNewLine & FormatSystemTime(st2) & vbNewLine & _
              (Format(Hour(timetaken), "00") & ":" & Format(Minute(timetaken), "00") & ":" & Format(Second(timetaken), "00")) & _
              "." & Format(msec2 - msec1, "000")

End Function

Function FormatSystemTime(st As SYSTEMTIME) As String
' Purpose: returns formatted system time with milliseconds
' cf Site: http://www.vbarchiv.net/tipps/tipp_1493-timestamp-inkl-millisekunden.html
  With st
    FormatSystemTime = Format(.wHour, "00") & ":" & Format(.wMinute, "00") & ":" & _
    Format(.wSecond, "00") & "." & Format(.wMilliseconds, "000")
  End With
End Function

Answer 1

这个怎么样

Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub timeMe()

    Dim start As Long, fini As Long
    Dim total As Long
    Dim ms As Long, sec As Long, min As Long, hr As Integer

    start = GetTickCount()

    Dim i, j: For i = 0 To 1000000: j = i ^ 2: Next i

    fini = GetTickCount()

    total = fini - start

'   total = 7545023                 ' test value:    2:05:45.023
'   total = 460382417               ' test value:  127:53:02.417

    ms = total Mod 1000
    sec = total \ 1000
    min = sec \ 60
    hr = min \ 60

    sec = sec Mod 60
    min = min Mod 60


    Debug.Print "runtime "; hr & ":" & Format(min, "00") & ":" & Format(sec, "00") & "." & Format(ms, "000")

End Sub