Как получить значение DateDiff в миллисекундах в VBA (Excel)?

Мне нужно рассчитать разницу между двумя метками времени в миллисекундах. К сожалению, функция DateDiff в VBA не обеспечивает такой точности. Есть ли обходные пути?


person Florian    schedule 02.06.2009    source источник


Ответы (7)


Вы можете использовать метод, описанный здесь следующим образом: -

Создайте новый модуль класса с именем 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, но они имеют точность только до одной сотой секунды (сантисекунды).

person Adam Ralph    schedule 02.06.2009
comment
Обратите внимание, что хотя GetTickCount разрешается в миллисекундах, его точность составляет около 16 мс см. эту статью MSDN - person chris neilsen; 26.01.2015
comment
Просто вопрос: как это может рассчитать разницу во времени между двумя значениями, хранящимися в Excel? - person patex1987; 18.01.2017
comment
Вопрос в том, как рассчитать разницу между двумя временными метками в VBA. - person Adam Ralph; 18.01.2017
comment
т.е. Эксель чисто случайно. - person Adam Ralph; 18.01.2017
comment
Это НЕ отвечает на вопрос ОП ВООБЩЕ. - person Excel Hero; 03.05.2020
comment
Это действительно делает шаг назад и предполагает, что важно время между двумя событиями, а не две уже предоставленные временные метки, но похоже, что это было то, что хотел сделать OP, и вот почему ответ принят. Во всяком случае, вопрос следует отредактировать, чтобы отразить то, что действительно хотел ОП. - person Adam Ralph; 04.05.2020

Если вам просто нужно время, прошедшее в сантисекундах, вам не нужен TickCount API. Вы можете просто использовать метод 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
person Oorang    schedule 02.06.2009

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
person Adarsha    schedule 04.06.2009

Вы также можете использовать формулу =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")
person ilya    schedule 04.10.2014

Извините, что разбудил этот старый пост, но я получил ответ:
Напишите функцию для Millisecond следующим образом:

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
person JayyM    schedule 01.03.2018

Если точности Timer() достаточно, вы можете просто создать метку времени, объединив дату и время с миллисекундами:

Function Now2() As Date

    Now2 = Date + CDate(Timer / 86400)

End Function

Чтобы вычислить разницу между двумя метками времени в миллисекундах, вы можете вычесть их:

Sub test()

    Dim start As Date
    Dim finish As Date
    Dim i As Long

    start = Now2
    For i = 0 To 100000000
    Next
    finish = Now2
    Debug.Print (finish - start) & " days"
    Debug.Print (finish - start) * 86400 & " sec"
    Debug.Print (finish - start) * 86400 * 1000 & " msec"

End Sub

Фактическая точность этого метода для меня составляет около 8 мс (кстати, GetTickCount еще хуже - 16 мс).

person omegastripes    schedule 15.11.2019

Помимо метода, описанного AdamRalph (GetTickCount()), вы можете сделать это:

person Tomalak    schedule 02.06.2009
comment
Есть ли плюсы или минусы в использовании QPC вместо Tickcount? - person Oorang; 06.06.2009
comment
Использование QueryPerformanceCounter() требует значительно больше кода. Возможно, это полезно, если вы уже имеете дело со счетчиками производительности в своем коде. Я просто хотел упомянуть альтернативу, я не думаю, что результаты отличаются. Я подозреваю, что в любом случае это сводится к GetTickCount() внутри. :) - person Tomalak; 06.06.2009