我需要以毫秒为单位计算两个时间戳之间的差异。不幸的是,VBA 的 DateDiff 函数不提供这种精度。有什么解决方法吗?
问问题
72102 次
7 回答
46
您可以使用此处描述的方法如下:-
创建一个新的类模块,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 计时器功能的使用,但这仅精确到百分之一秒(厘秒)。
于 2009-06-02T12:35:20.530 回答
16
如果您只需要以 Centiseconds 为单位的时间,那么您不需要 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
于 2009-06-02T18:58:19.273 回答
1
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
于 2009-06-04T01:56:15.787 回答
1
如果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 毫秒)。
于 2019-11-15T19:53:45.297 回答
0
您还可以使用=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")
于 2014-10-04T14:42:36.887 回答
0
很抱歉唤醒这篇旧帖子,但我得到了一个答案:
为毫秒编写一个函数,如下所示:
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
于 2018-03-01T08:37:38.430 回答
-1
除了 AdamRalph ( GetTickCount()
) 描述的方法之外,您还可以这样做:
- 使用
QueryPerformanceCounter()
和QueryPerformanceFrequency()
API 函数
如何测试 VBA 代码的运行时间? - 或者,对于无法访问 Win32 API(如 VBScript)的环境,请访问:
http ://ccrp.mvps.org/ (查看“高性能计时器”可安装 COM 对象的下载部分。它们是免费的。)
于 2009-06-02T12:49:52.233 回答