web-dev-qa-db-ja.com

VBA（Excel）でミリ秒単位のDateDiff値を取得する方法

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

excelvbaexcel-vbadatediff
20
Florian

次のように、説明されている方法 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タイマー機能の使用について説明していますが、これは100分の1秒（センチ秒）までしか正確ではありません。

44
Adam Ralph

センチ秒単位の経過時間が必要な場合は、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
11
Oorang

GetTickCountとPerformance Counterは、マイクロ秒で移動したい場合に必要です。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
1
Adarsha

この古い投稿を目覚めさせたことをお詫びしますが、私は答えを得ました：
次のようにミリ秒の関数を記述します。

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
0
JayyM

セルで計算された=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")
0
ilya