Como obter um DateDiff-valor em milissegundos em VBA (Excel)?

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

  •  06-09-2019
  •  | 
  •  

Pergunta

Eu preciso calcular a diferença entre dois carimbos de hora em milissegundos. Infelizmente, o DateDiff-função de VBA não oferece esta precisão. Há soluções temporárias?

Foi útil?

Solução

Você pode usar o método descrito aqui da seguinte forma: -

Criar um novo módulo de classe chamado StopWatch Coloque o seguinte código no módulo de classe 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

Você usa o código da seguinte forma: 

Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer

' Do whatever you want to time here

Debug.Print "That took: " & sw.EndTimer & "milliseconds"

Outros métodos descrevem o uso da função VBA Temporizador mas isso só é preciso um centésimo de segundo (centisecond).

Outras dicas

tempo Se você só precisa decorrido em centésimos de segundo, então você não precisa da API TickCount. Você pode apenas usar o método VBA.Timer que está presente em todos os produtos do 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 e contador de desempenho são necessários se você quer ir para micro segundos .. Para millisenconds você pode apenas usar alguma coisa como esta .. 

'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

Você também pode usar a fórmula =NOW() calculado na célula: 

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

Desculpas para acordar este post antigo, mas eu tenho uma resposta:
Escreva uma função para Milissegundo assim: 

Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2) 
End Function

Use esta função no seu sub: 

Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub

Além do método descrito por AdamRalph (GetTickCount()), você pode fazer isso:

Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top