Как получить значение DateDiff в миллисекундах в VBA (Excel)?
Вопрос
Мне нужно вычислить разницу между двумя временными метками в миллисекундах.К сожалению, функция DateDiff VBA не обеспечивает такой точности.Есть ли обходные пути?
Решение
Вы можете использовать описанный метод здесь следующее:-
Создайте новый модуль класса под названием StopWatch
Поместите следующий код в 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
Вы используете код следующим образом:
Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer
' Do whatever you want to time here
Debug.Print "That took: " & sw.EndTimer & "milliseconds"
Другие методы описывают использование функции таймера VBA, но с точностью до одной сотой секунды (сантисекунды).
Другие советы
Если вам просто нужно время, прошедшее в сантисекундах, вам не нужен API TickCount.Вы можете просто использовать метод VBA.Timer, который присутствует во всех продуктах 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 и счетчик производительности необходимы, если вы хотите использовать микросекунды.Для миллисекунд вы можете просто использовать что-то вроде этого.
'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
Вы также можете использовать =NOW()
формула, рассчитанная в ячейке:
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")
Извините, что разбудил этот старый пост, но я получил ответ:
Напишите функцию для миллисекунд следующим образом:
Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function
Используйте эту функцию в своем сабвуфере:
Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub
Помимо метода, описанного Адамом Ральфом (GetTickCount()
), вы можете сделать это:
- Используя
QueryPerformanceCounter()
иQueryPerformanceFrequency()
API-функции
Как вы проверяете время выполнения кода VBA? - или, для сред без доступа к Win32 API (например, VBScript), это:
http://ccrp.mvps.org/ (проверьте раздел загрузки для устанавливаемых COM-объектов «Высокопроизводительный таймер»).Они бесплатны.)