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

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

19
datediff excel excel-vba vba

6 ответов

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

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

43

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

GetTickCount и счетчик производительности требуются, если вы хотите перейти на микро секунд.. Для millisenconds вы можете просто использовать некоторые вещи, как это.. 

'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

вы также можете использовать =NOW() формула calcilated в ячейке:

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

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

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

используйте эту функцию в своем sub:

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

кроме метода, описанного Адамральфом (GetTickCount()), вы можете сделать это:

  • С помощью QueryPerformanceCounter() и QueryPerformanceFrequency() функции API
    как вы тестируете время работы кода VBA?
  • или, для сред без доступа к Win32 API (например, VBScript), это:
    http://ccrp.mvps.org/ (проверьте раздел загрузки для" высокопроизводительного таймера " устанавливаемых COM-объектов. Они свободны.)
-1