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

StackOverflow https://stackoverflow.com/questions/939230

  •  06-09-2019
  •  | 
  •  

题

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

有帮助吗？

解决方案

您可以使用描述此处该方法如下： -

创建名为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定时器功能，但是这仅是精确到秒（厘秒）的百分之一。

其他提示

如果你只需要在厘秒经过的时间，那么你不需要计时单位计数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

的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

您还可以使用在细胞计算=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")

道歉唤醒这个老帖子，但我得到了一个答案：点击 像这样写为毫秒的函数：

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

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

  • 使用 QueryPerformanceCounter() 和 QueryPerformanceFrequency() API函数
    如何测试VBA代码的运行时间？
  • 或者，对于无法访问 Win32 API（如 VBScript）的环境，如下所示：
    http://ccrp.mvps.org/ （检查“高性能定时器”可安装 COM 对象的下载部分。他们是免费的。）
许可以下： CC-BY-SA 和 归因
不隶属于 StackOverflow
scroll top