Cómo obtener un DifFecha-Valor en milisegundos en VBA (Excel)?

Question

necesito para calcular la diferencia entre dos marcas de tiempo en milisegundos. Por desgracia, la DifFecha funciones de VBA no ofrece esta precisión. ¿Hay alguna solución?

Answer 1

Se puede usar el método descrito aquí como sigue: -

Crear un nuevo módulo de clase llamada StopWatch Coloque el código siguiente en el módulo de clase StopWatch:

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 de la función de VBA Timer pero esto es sólo una precisión de una centésima de segundo (centisegundo).

Answer 2

Si sólo necesita tiempo transcurrido en centisegundos a continuación, usted no necesita la API TickCount. Usted sólo puede utilizar 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 3

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 4

También puede utilizar fórmula =NOW() calculado 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 5

Disculpas para despertar este antiguo puesto, pero me dio una respuesta:
Escribir 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

Answer 6

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

• Uso de la API y QueryPerformanceCounter() QueryPerformanceFrequency() Funciones
  ¿Cómo se prueba momento de ejecutar código VBA?
• o, para entornos sin acceso a la API de Win32 (como VBScript), esto:
  http://ccrp.mvps.org/ (consultar la sección de descargas del "Temporizador de alto rendimiento" objetos COM instalables. Son libres.)