VBA - 使用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

Answer 2

TimeGetTime函数返回自系统启动以来的毫秒数，并且相当容易使用。

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

public Sub test()
Dim started As Long
Dim ended   As Long   

started = timeGetTime ' Get milliseconds since startup
'//Do your work that you want timed here    
ended = timeGetTime
Debug.Print "Time Taken = " & ended - started  & " milliseconds"
End Sub

当然，您可以将差异除以秒，分钟和小时。注意Long数据类型的长度有限，如果经过的时间超过25天，则将其设置为负数（VBA长数据类型的最大值为2,147,483,647，大约为24.85天）< / p>

Answer 3

Option Explicit

' System MS Excel version 2010, VBA7 and Windows 10_64bit
' API Declaration
Private Declare PtrSafe 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
    Dim st3       As SYSTEMTIME

    Dim Stamp1mS  As Integer
    Dim Stamp2mS  As Integer
    Dim Stamp3mS  As Integer
    Dim Stamp1sec As Integer
    Dim Stamp2sec As Integer
    Dim Stamp3sec As Integer

    GetSystemTime st1     ' Start time
    Sleep 1               ' Do something
    GetSystemTime st2     ' Another moment
    Sleep 3               ' Do something else
    GetSystemTime st3     ' End time

    ' ================
    ' Show System time elapsed with milliseconds as work around
    ' ================
    ' MsgBox SystemTimeDiff(st1, st2), vbInformation, "Systemtime elapsed" ;
    ' be aware Stamp2mS might be less than Stamp1mS
    Stamp1mS = st1.wMilliseconds
    Stamp2mS = st2.wMilliseconds
    Stamp3mS = st3.wMilliseconds
    Stamp1sec = st1.wSecond
    Stamp2sec = st2.wSecond
    Stamp3sec = st3.wSecond
    MsgBox ("You can use the result for futher calculations." + Chr(13) + Chr(13) + Str(Stamp1sec) + "  " + Str(Stamp1mS) + Chr(13) + Str(Stamp2sec) + "  " + Str(Stamp2mS) + Chr(13) + Str(Stamp3sec) + "  " + Str(Stamp3mS))
End Sub