如何在VBA (Excel)中获取以毫秒为单位的数据扩散值?

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的数据流函数不能提供这种精度。有什么解决方法吗?

6 个解决方案

#1

You could use the method described here as follows:-

您可以使用以下描述的方法:-。

Create a new class module called StopWatch Put the following code in the StopWatch class module:

创建一个名为秒表的新类模块，将以下代码放入秒表类模块:

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定时器函数的使用，但这只能精确到百分之一秒。

#2

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了。你可以用VBA。定时器方法存在于所有的办公产品中。

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

#3

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和性能计数器。对于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

#4

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")

#5

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

#6

-1

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?
使用QueryPerformanceCounter()和QueryPerformanceFrequency() API函数，如何测试VBA代码的运行时间?
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.)
或者，对于无法访问Win32 API(如VBScript)的环境，可以使用http://ccrp.mvps.org/(请查看下载部分以获得“高性能计时器”可安装COM对象)。它们是免费的。)

#1