VBA - функция таймера с пошаговым захватом прошедшего времени

Question

Я искал функцию таймера, которую можно легко встроить в мои программы, чтобы показать, сколько секунд занимает каждый шаг. Я делаю это с обычным debug.print и несколькими переменными, что делает мой код занятым, а также трудно вычитать новый таймер из последнего записанного шага, что также является излишним. Я ищу функцию, чтобы фиксировать время, необходимое для каждого шага, а также узнать общее время, прошедшее с первого шага.

Answer 1

Вот что я разработал для этой цели. Вы должны объявить открытый объект типа «Scripting.Dictionary», а также длинную переменную как ti.

Позднее связывание:

Public d As Object, ti as long

и в одном вы ваши процедуры, до вызова функции:

Set d = CreateObject("Scripting.Dictionary")

Раннее связывание

Вы можете использовать раннее связывание, если у вас уже есть среда выполнения сценариев Microsoft, добавленная в вашу библиотеку. Ваша декларация будет выглядеть так:

Dim d As New Scripting.Dictionary, ti as long

в любом случае вот это:

Функция

Заголовок - это строка в качестве напоминания или тега этапа / шага в коде.
Newstart должен установить TRUE для первого экземпляра функции.
NeedTotal должен установить значение true, если вы хотите, чтобы общее время истекло до этой стадии.

Public Function gettimer(Optional ByVal Title As String, _
                     Optional ByVal Newstart As Boolean, _
                     Optional ByVal NeedTotal As Boolean)
If Newstart = True Or ti = 0 Then
    ti = 0
    d("T0") = Timer
    gettimer = ti & vbTab & vbTab & "0.00" & vbTab & vbTab & "Start @ " _
    & Format(Time, "h:mm:ss") & vbTab & Title
Else
    gettimer = ti & vbTab & vbTab & Format(Round(Timer - d("T" & ti - 1), 2), "0.00") _
    & vbTab & vbTab & Title
    d("T" & ti) = Timer
End If
If NeedTotal Then
    gettimer = gettimer & vbTab & vbTab & vbTab & "Time elapsed from the start = " _
    & vbTab & Round(d("T" & ti) - d("T0"), 4)
End If
ti = ti + 1
Debug.Print gettimer
End Function