¿Cómo obtener un DateDiff-Value en milisegundos en VBA (Excel)?

Question

Necesito calcular la diferencia entre dos marcas de tiempo en milisegundos. Desafortunadamente, la función DateDiff de VBA no ofrece esta precisión. ¿Hay alguna solución?

Answer 1

Se puede usar el método descrito here de la siguiente manera: -

Crear un nuevo módulo de clase llamado StopWatch poner el código siguiente en el módulo StopWatch clase:

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 

Se utiliza el código de la siguiente manera :

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

' Do whatever you want to time here 

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

Otros métodos describen el uso del temporizador VBA función, pero esto solo es preciso a una centésima de segundo (centisegundo).

Answer 2

Además del método descrito por AdamRalph (GetTickCount()), usted puede hacer esto:

• Usando los QueryPerformanceCounter() y QueryPerformanceFrequency() funciones de la API
  How do you test running time of VBA code?
• o, para entornos sin acceso a la API de Win32 (como VBScript), esto:
  http://ccrp.mvps.org/ (consulte la sección de descarga de los objetos COM instalables "Temporizador de alto rendimiento". Son gratuitos.)

Answer 3

Si solo necesita tiempo transcurrido en Centisegundos, entonces no necesita la API TickCount. Solo puede usar el método VBA.Timer que está presente en todos los productos de 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 y contador de rendimiento son necesarios si desea ir para micro segundos .. Para millisenconds sólo se puede usar algo como esto ..

'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

También puede utilizar =NOW() fórmula calcilated en la celda:

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

Disculpas a despertar este antiguo puesto, pero me dio una respuesta:
Escriba una función de milisegundos como esto:

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

Utilice esta función en su substitución:

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