Wie ein DateDiff-Wert in Millisekunden in VBA (Excel) zu bekommen?
Frage
Ich brauche den Unterschied zwischen zwei Zeitstempel in Millisekunden zu berechnen. Leider hat die DateDiff-Funktion von VBA nicht diese Präzision bieten. Gibt es Workarounds?
Lösung
Sie könnten das beschriebene Verfahren verwenden hier wie folgt: -
Erstellen Sie ein neues Klassenmodul namens StopWatch
Setzen Sie den folgenden Code in dem StopWatch
Klassenmodul:
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
Sie verwenden den Code wie folgt:
Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer
' Do whatever you want to time here
Debug.Print "That took: " & sw.EndTimer & "milliseconds"
Andere Methoden beschreiben Verwendung der VBA-Timer-Funktion, aber das ist nur genau ein Hundertstel einer Sekunde (Zentisekunde).
Andere Tipps
Wenn Sie nur Zeit in Hundertstelsekunden vergangen müssen, dann müssen Sie nicht über die API Tickcount. Sie können nur die VBA.Timer Methode verwenden, die in allen Office-Produkten vorhanden ist.
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 und Performance Counter sind erforderlich, wenn Sie für Mikrosekunden gehen wollen .. Für millisenconds können Sie nur etwas, was wie folgt verwenden ..
'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
Sie können auch =NOW()
Formel berechnet in der Zelle verwendet werden:
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")
Apologies diese alte Post aufzuwachen, aber ich bekam eine Antwort:
Schreiben Sie eine Funktion für Millisekunde wie folgt aus:
Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function
Verwenden Sie diese Funktion in Ihrem sub:
Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub
Neben der Methode von AdamRalph (GetTickCount()
) beschrieben, können Sie dies tun:
- Verwenden der
QueryPerformanceCounter()
undQueryPerformanceFrequency()
API-Funktionen
Wie testen Sie Zeit von VBA-Code ausgeführt wird? - oder für Umgebungen ohne Zugriff auf den Win32-API (wie VBScript), dies:
http://ccrp.mvps.org/ (überprüfen Sie den Download-Bereich für den "High-Performance-Timer" installierbare COM-Objekte. Sie sind frei).