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

StackOverflow https://stackoverflow.com/questions/939230

  •  06-09-2019
  •  | 
  •  

Domanda

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

È stato utile?

Soluzione

È possibile utilizzare il metodo descritto qui come segue: -

Creare un nuovo modulo di classe denominato StopWatch Inserire il seguente codice nel modulo di classe 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

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'uso della funzione Timer VBA ma questo è accurato solo al centesimo di secondo (dei centesimi).

Altri suggerimenti

Se avete solo bisogno di tempo trascorso in centesimi di secondo, allora non è necessario l'API TickCount. Si può solo 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

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

È inoltre possibile utilizzare la formula =NOW() calcolata 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")

Ci scusiamo per svegliare questo vecchio post, ma ho avuto 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

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

Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top