Come ottenere un valore DateDiff in millisecondi in VBA (Excel)?

Question

Ho bisogno di calcolare la differenza tra due timestamp in millisecondi. Sfortunatamente, la funzione DateDiff di VBA non offre questa precisione. Esistono soluzioni alternative?

Answer 1

È possibile utilizzare il metodo descritto here come segue: -

Creare un nuovo modulo di classe denominato StopWatch inserire il seguente codice nel modulo di StopWatch classe:

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 

Si utilizza il codice come segue :

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

' Do whatever you want to time here 

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

Altri metodi descrivono l'utilizzo del timer VBA funzione ma questo è solo accurato al centesimo di secondo (centisecondo).

Answer 2

Oltre al metodo descritto da AdamRalph (GetTickCount()), si può fare questo:

• Uso delle funzioni QueryPerformanceCounter() e QueryPerformanceFrequency() API
  How do you test running time of VBA code?
• o, per ambienti senza accesso alle API Win32 (come VBScript), questo:
  http://ccrp.mvps.org/ (controllare la sezione di download per gli oggetti COM installabili "High-Performance Timer". Sono gratuiti.)

Answer 3

Se è necessario solo il tempo trascorso in Centisecondi, non è necessario l'API TickCount. Puoi semplicemente utilizzare il metodo VBA.Timer che è presente in tutti i prodotti Office.

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 

Answer 4

GetTickCount e contatore delle prestazioni sono necessari se si vuole andare per le micro secondi .. Per millisenconds si può semplicemente usare qualche cosa come questa ..

'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 

Answer 5

È inoltre possibile utilizzare la formula =NOW() calcilated nella cella:

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") 

Answer 6

Scuse a svegliarsi questo vecchio post, ma ho ricevuto una risposta:
Scrivere una funzione per millisecondo in questo modo:

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

Usare questa funzione nel vostro sub:

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