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

Question

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

Answer 1

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

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

Answer 2

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

• Использование QueryPerformanceCounter() и QueryPerformanceFrequency() функций API
  How do you test running time of VBA code?
• или, для сред, не имеющих доступа к API Win32 (например, VBScript):
  http://ccrp.mvps.org/ (ознакомьтесь с разделом загрузки для устанавливаемых COM-объектов «Высокопроизводительный таймер».)

Answer 3

Если вам просто нужно время, прошедшее через Centiseconds, вам не нужен 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 

Answer 4

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 

Answer 5

Вы также можете использовать =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") 

Answer 6

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

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