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

Question

我需要计算两个时间戳之间的毫秒差异。不幸的是，VBA的DateDiff函数没有提供这种精度。是否有任何解决方法？

- Florian

Answer 1

您可以按照下面描述的方法使用此处所述：

创建名为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 Timer函数，但这仅精确到百分之一秒（百分秒）。

- Adam Ralph

---

请注意，虽然GetTickCount返回的是毫秒数，但其精度约为16毫秒 请参见此MSDN文章。 - chris neilsen

只是一个问题：如何计算存储在Excel中的2个值之间的时间差？ - patex1987

这个问题是关于如何在VBA中计算两个时间戳之间的差异。 - Adam Ralph

即Excel纯属巧合。 - Adam Ralph

这完全没有回答楼主的问题。 - Excel Hero

它确实退了一步，并假设两个“事件”之间的时间是重要的，而不是已经提供的两个时间戳，但似乎这正是OP想要做的，这就是为什么答案被接受的原因。如果有什么问题，应该编辑问题以反映OP真正想要的内容。 - Adam Ralph

Answer 2

如果你只需要以百分之一秒为单位的经过时间，那么你不需要使用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

- Oorang

Answer 3

如果 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毫秒）。

- omegastripes

Answer 4

如果您想要达到微秒级的精度，就需要使用 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

- Adarsha

Answer 5

你也可以在单元格中使用=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")

- ilya

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

- JayyM

Answer 7

除了AdamRalph所描述的方法(GetTickCount())，你还可以这样做：

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

- Tomalak

---

使用 QPC 而不是 Tickcount 是否有优点或缺点？ - Oorang

使用QueryPerformanceCounter()需要更多的代码。如果您已经在代码中处理perf计数器，则可能很有用。我只是想提及另一种选择，我认为结果没有任何不同。我怀疑这归结于GetTickCount()在内部的实现方式。 :) - Tomalak