VBA, MS Access MS Access в примерах

Разница во времени с точностью до милисекунд

Private Function ElapsedTimeStr(dmsTimeStart As Date, dmsTimeEnd As Date) As String
' es - 25.05.2023 v01 - Функция расчитывает разницу во времени с точностью до милисекунд
' Возвращает отформатированную строку продолжительности (теста) формата: "00:00:00.000"
' -------------------------------------------------------------------------------------------------/
'Пример эксплуотации:
'    Dim datStart As Date, datEnd As Date
'    datStart = Date + CDate(Timer / 86400) 'Время начала
'    ' инструкции ... + ещё инструкции ...
'    datEnd = Date + CDate(Timer / 86400) 'Время окончания
'    Debug.Print "Продолжительность выполнения: " & ElapsedTimeStr(datStart, datEnd)
' -------------------------------------------------------------------------------------------------/
Dim datDiff As Date, curTotalSeconds As Currency, curVar@, intMilSec As Integer
' Расчёт:
    datDiff = dmsTimeEnd - dmsTimeStart              ' Проделжительность всего дней
    curTotalSeconds = datDiff * 86400                ' Проделжительность в секундах (дробное)
    curVar = curTotalSeconds - Fix(curTotalSeconds)  ' Выделение дробноой части секунд
    intMilSec = Fix(curVar * 1000)                   ' Дробное переводим в кол-во милисекунд
    ElapsedTimeStr = Format(datDiff, "hh:mm:ss") & "." & Format(intMilSec, "000")

End Function


Пример эксплуотации:

Private Sub ElapsedTimeStrTEST() ' Пример эксплуотации:
Dim datStart As Date, datEnd As Date

    datStart = Date + CDate(Timer / 86400) 'Время начала

'Просто короткая задержка вычислениями для примера:
    Dim lngVal As Long, vVal
    For lngVal = 0 To 500000
        vVal = Round(lngVal * 23.56, 3)
    Next lngVal
    
    datEnd = Date + CDate(Timer / 86400) 'Время окончания

'Отчёт:
    Debug.Print "Продолжительность выполнения теста: " & ElapsedTimeStr(datStart, datEnd)
    MsgBox "Все расчёты успешно выполнены." & vbCrLf & "Продолжительность выполнения: " & _
            ElapsedTimeStr(datStart, datEnd), vbInformation, "Результат получен!"
End Sub


Эксперимент:

Sub testMilliSecondsDiff()
Dim dtStart As Date, dtFinish As Date, dtDifference As Date
Dim iVal As Long
    
    dtStart = Date + CDate(Timer / 86400)
    
    For iVal = 0 To 500000000: Next iVal
    
    dtFinish = Date + CDate(Timer / 86400)
    dtDifference = dtFinish - dtStart

    Debug.Print "Прошло:" & DateDiff("d", dtStart, dtFinish) & " дней и " & Format(dtFinish - dtStart, "hh:nn:ss")
    Debug.Print dtDifference * 24 & " часов"
    Debug.Print dtDifference * 1440 & " минут"
    Debug.Print dtDifference * 86400 & " секунд"
    Debug.Print Format(dtDifference * 86400 * 1000, "0.000") & " милисекунд"
    Debug.Print String(60, "-")
    
End Sub
Назад ToTop
L.E. 23.06.2023
Рейтинг@Mail.ru