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

Question

J'ai besoin de calculer la différence entre deux horodatages en millisecondes. Malheureusement, la fonction DateDiff de VBA n'offre pas cette précision. Y a-t-il des solutions de contournement?

Answer 1

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

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

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 minuterie VBA fonction mais ceci n'est précis qu'à un centième de seconde (centiseconde).

Answer 2

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

• Utilisation des QueryPerformanceCounter() et QueryPerformanceFrequency() Fonctions API
  How do you test running time of VBA code?
• ou, pour les environnements sans accès à l'API Win32 (comme VBScript), ceci:
  http://ccrp.mvps.org/ (vérifiez la section de téléchargement pour les objets COM installables "Minuterie haute performance", ils sont gratuits.)

Answer 3

Si vous avez juste besoin de temps écoulé en Centisecondes, vous n'avez pas besoin de l'API TickCount. Vous pouvez simplement utiliser la méthode VBA.Timer qui est présente dans tous les produits 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 et compteur de performance sont nécessaires si vous voulez aller microsecondes .. Pour millisenconds vous pouvez simplement 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 

Answer 5

Vous pouvez également utiliser la formule =NOW() calcilated 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") 

Answer 6

Toutes mes excuses à réveiller ce vieux poste, mais je m'y suis une réponse:
Ecrire 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 sous:

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