VBA (Excel) でミリ秒単位で DateDiff-Value を取得するにはどうすればよいですか?

Question

2 つのタイムスタンプの差をミリ秒単位で計算する必要があります。残念ながら、VBA の DateDiff 関数ではこの精度は提供されません。回避策はありますか?

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タイマー機能の使用を記載しているが、これは第二の（センチ）100分の1にのみ正確である。

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とパフォーマンスカウンタが必要とされています。.. 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

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

謝罪は、この古いポストを覚ますために、しかし、私は答えを得ます。
このようなミリ秒のための関数を記述します：

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

AdamRalph によって説明されたメソッドのほかに (GetTickCount()）、 あなたはこれを行うことができます：

• の使用 QueryPerformanceCounter() そして QueryPerformanceFrequency() API関数
  VBA コードの実行時間をテストするにはどうすればよいですか?
• または、Win32 API (VBScript など) にアクセスできない環境の場合は、次のようになります。
  http://ccrp.mvps.org/ (「ハイパフォーマンス タイマー」のインストール可能な COM オブジェクトについては、ダウンロード セクションを確認してください。無料です。）