Comment obtenir une valeur de DateDiff en millisecondes dans VBA (Excel)?

je dois calculer la différence entre deux repères temporels en millisecondes. Malheureusement, la fonction DateDiff de VBA n'offre pas cette précision. Existe-il des solutions?

19
demandé sur lfrandom 2009-06-02 16:24:44

6 réponses

Vous pouvez utiliser la méthode décrite ici comme suit:

Créer un nouveau module de classe appelé StopWatch Placez le code suivant dans la balise StopWatch module de 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

Vous utilisez le code comme suit:

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

' Do whatever you want to time here

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

D'autres méthodes décrivent l'utilisation de la fonction de minuterie VBA mais celle-ci n'est exacte qu'à un centième de seconde (centiseconde).

43
répondu Adam Ralph 2012-06-15 19:59:40

si vous avez juste besoin du temps écoulé En Centisecondes, alors vous n'avez pas besoin de L'API TickCount. Vous pouvez utiliser le VBA.Méthode de minuterie qui est présente dans tous les produits de bureau.

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
9
répondu Oorang 2009-06-04 02:19:50

GetTickCount et Performance Counter sont nécessaires si vous voulez aller pour micro secondes.. Pendant des millisencondes, vous pouvez utiliser quelque chose comme ça.. 

'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
1
répondu Adarsha 2012-03-27 15:45:29

Vous pouvez également utiliser =NOW() formule calculée dans la cellule:

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")
0
répondu ilya 2014-10-04 15:02:09

Excuses à réveiller ce vieux post, mais j'ai obtenu une réponse:

Écrire une fonction pour Milliseconde comme ceci: 

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

utilisez cette fonction dans votre sub:

Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub
0
répondu JayyM 2018-03-01 08:37:38

outre la méthode décrite par AdamRalph (GetTickCount()), vous pouvez faire ceci:

-1
répondu Tomalak 2017-05-23 12:34:06