Question

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

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

如果您只需要以秒为单位的时间，那么您就不需要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

Answer 3

如果您想要微秒钟，则需要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

Answer 4

您还可以使用在单元格中计算的=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")

Answer 5

道歉醒来这个老帖子，但我得到了答案：
像这样写一个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

Answer 6

如果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毫秒（BTW GetTickCount甚至更差-16毫秒）。

Answer 7

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

使用QueryPerformanceCounter()和QueryPerformanceFrequency() API函数
How do you test running time of VBA code?
或者，对于无法访问Win32 API的环境（如VBScript），这个：
http://ccrp.mvps.org/（查看“高性能计时器”可安装COM对象的下载部分。它们是免费的。）

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

7 个答案: