如何在 VBA (Excel) 中以毫秒为单位获取 DateDiff 值？

How to get a DateDiff-Value in milliseconds in VBA (Excel)?

提问by Florian

I need to calculate the difference between two timestamps in milliseconds. Unfortunately, the DateDiff-function of VBA does not offer this precision. Are there any workarounds?

我需要以毫秒为单位计算两个时间戳之间的差异。不幸的是，VBA 的 DateDiff 函数不提供这种精度。有什么解决方法吗？

回答by Adam Ralph

You could use the method described hereas follows:-

您可以使用此处描述的方法，如下所示：-

Create a new class module called StopWatchPut the following code in the StopWatchclass module:

创建一个名为的新类模块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

You use the code as follows:

您可以按如下方式使用代码：

Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer

' Do whatever you want to time here

Debug.Print "That took: " & sw.EndTimer & "milliseconds"

Other methods describe use of the VBA Timer function but this is only accurate to one hundredth of a second (centisecond).

其他方法描述了 VBA 计时器功能的使用，但这只能精确到百分之一秒（厘秒）。

回答by Oorang

If you just need time elapsed in Centiseconds then you don't need the TickCount API. You can just use the VBA.Timer Method which is present in all Office products.

如果您只需要以厘秒为单位的时间流逝，那么您不需要 TickCount API。您可以只使用所有 Office 产品中都存在的 VBA.Timer 方法。

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

回答by Adarsha

GetTickCount and Performance Counter are required if you want to go for micro seconds.. For millisenconds you can just use some thing like this..

如果您想要微秒，则需要 GetTickCount 和 Performance Counter .. 对于毫秒，您可以使用这样的东西..

'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

回答by ilya

You can also use =NOW()formula calcilated in cell:

您还可以使用=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")

回答by JayyM

Apologies to wake up this old post, but I got an answer:
Write a function for Millisecond like this:

抱歉唤醒这个旧帖子，但我得到了一个答案：
像这样为毫秒编写一个函数：

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

Use this function in your sub:

在您的子程序中使用此功能：

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

回答by omegastripes

If Timer()precision is enough then you can just create timestamp by combining date and time with milliseconds:

如果Timer()精度足够，那么您可以通过将日期和时间与毫秒相结合来创建时间戳：

Function Now2() As Date

    Now2 = Date + CDate(Timer / 86400)

End Function

To calculate the difference between two timestamps in milliseconds you may subtract them:

要以毫秒为单位计算两个时间戳之间的差异，您可以减去它们：

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

Actual precision of that method is about 8 msec (BTW GetTickCountis even worse - 16 msec) for me.

GetTickCount对我来说，该方法的实际精度约为 8 毫秒（顺便说一句，更糟 - 16 毫秒）。

回答by Tomalak

Besides the Method described by AdamRalph (GetTickCount()), you can do this:

除了 AdamRalph ( GetTickCount())描述的方法之外，您还可以这样做：

• Using the QueryPerformanceCounter()and QueryPerformanceFrequency()API Functions
  How do you test running time of VBA code?
• or, for environments without access to the Win32 API (like VBScript), this:
  http://ccrp.mvps.org/(check the download section for the "High-Performance Timer" installable COM objects. They're free.)

• 使用QueryPerformanceCounter()和QueryPerformanceFrequency()API 函数
  如何测试 VBA 代码的运行时间？
• 或者，对于无法访问 Win32 API（如 VBScript）的环境，请访问：
  http: //ccrp.mvps.org/（查看“高性能计时器”可安装 COM 对象的下载部分。它们是免费的。）