How to get a DateDiff-Value in milliseconds in VBA

问题:

I need to calculate the difference between two timestamps in milliseconds. Unfortunately, the DateDiff-function of VBA does not offer this precision. Are there any workarounds?

回答1:

You could use the method described here as follows:-

Create a new class module called StopWatch Put the following code in the StopWatch class module:

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

Public Sub StartTimer()
    mlngStart = GetTickCount
End Sub

Public Function EndTimer() As Long
    EndTimer = (GetTickCount - mlngStart)
End Function

You use the code as follows:

Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer

' Do whatever you want to time here

Debug.Print "That took: " & sw.EndTimer & "milliseconds"

Other methods describe use of the VBA Timer function but this is only accurate to one hundredth of a second (centisecond).

回答2:

If you just need time elapsed in Centiseconds then you don't need the TickCount API. You can just use the VBA.Timer Method which is present in all Office products.

Public Sub TestHarness()
    Dim fTimeStart As Single
    Dim fTimeEnd As Single
    fTimeStart = Timer
    SomeProcedure
    fTimeEnd = Timer
    Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centiseconds Elapsed""")
End Sub

Public Sub SomeProcedure()
    Dim i As Long, r As Double
    For i = 0& To 10000000
        r = Rnd
    Next
End Sub

回答3:

GetTickCount and Performance Counter are required if you want to go for micro seconds.. For millisenconds you can just use some thing like this..

'at the bigining of the module
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  

Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)  


'In the Function where you need find diff
Dim sSysTime As SYSTEMTIME
Dim iStartSec As Long, iCurrentSec As Long    

GetLocalTime sSysTime
iStartSec = CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'do your stuff spending few milliseconds
GetLocalTime sSysTime ' get the new time
iCurrentSec=CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'Different between iStartSec and iCurrentSec will give you diff in MilliSecs

回答4:

You can also use =NOW() formula calcilated in cell:

Dim ws As Worksheet
Set ws = Sheet1

 ws.Range("a1").formula = "=now()"
 ws.Range("a1").numberFormat = "dd/mm/yyyy h:mm:ss.000"
 Application.Wait Now() + TimeSerial(0, 0, 1)
 ws.Range("a2").formula = "=now()"
 ws.Range("a2").numberFormat = "dd/mm/yyyy h:mm:ss.000"
 ws.Range("a3").formula = "=a2-a1"
 ws.Range("a3").numberFormat = "h:mm:ss.000"
 var diff as double
 diff = ws.Range("a3")

回答5:

Apologies to wake up this old post, but I got an answer:
Write a function for Millisecond like this:

Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2) 
End Function    

Use this function in your sub:

Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub

回答6:

Besides the Method described by AdamRalph (GetTickCount()), you can do this:

• Using the QueryPerformanceCounter() and QueryPerformanceFrequency() API Functions
  How do you test running time of VBA code?
• or, for environments without access to the Win32 API (like VBScript), this:
  http://ccrp.mvps.org/ (check the download section for the "High-Performance Timer" installable COM objects. They're free.)