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

Модуль для сравнения скорости работы Процедур (Функций)

Давно уже пользуюсь подобным , наглядно, и сразу видно какой из двух (3х-4х...) вариантов аналогичного кода быстрее работает.

Модуль:

Private Sub SpeedCompare()
' es - 10.05.2022 - LE 10.05.2024 v08
' Процедура для сравнения работы процедур или функций по скорости
' Пишет результат в Immediate Window
' -------------------------------------------------------------------------------------------------/
Const сiTotTests As Integer = 4       ' Установка количества тестов ("тестируемых" процедур или функций)
Const сlngIterations As Long = 1000   ' Установка количества повторений теста
' -------------------------------------------------------------------------------------------------/
Dim intTestNo As Integer       ' Номер теста (1, 2 ... )
Dim lngIteration As Long       ' Счетчик повторений
Dim strTestNote As String      ' Примечание к совокупности тестов - конец заголовка (в скобках)
Dim strTestName As String      ' Название процедуры|функции - для отчёта в Immediate Window
Dim sglTimerStart As Single, sglTimerEnd As Single ' Для замера продолжительности процесса
' -------------------------------------------------------------------------------------------------/
Dim vVal, sReport$
On Error GoTo SpeedCompare_Err

    Screen.MousePointer = 11            ' Курсор = часы ...
    strTestNote = "Demo v008"           ' Примечание к совокупности тестов - конец заголовка (в скобках)
    sReport = "Тест из " & Format$(сlngIterations, "#,##0") & " повторов" & _
               IIf(Len(strTestNote) > 0, " (" & strTestNote & ")", "") & ":"
    Debug.Print sReport
' -------------------------------------------------------------------------------------------------/
             
    For intTestNo = 1 To сiTotTests  ' Запуск тестов в заданном кол-ве
        Select Case intTestNo        ' Тут можно расписать названия тестов (опционально)
            Case 1: strTestName = "Round() Function"   ' Имя тестируеймой(мого) 1 и т.д.
            Case 2: strTestName = "Format() Function"  ' Имя тестируеймой(мого) 2 ... и т.д.
            Case 3: strTestName = "Fix() Function"
            Case 4: strTestName = "Int() Function"
        End Select
        sglTimerStart = Timer ' Timer начала (дробные секунды (Single) прошедшие с начала суток)
        
        For lngIteration = 1 To сlngIterations        ' Старт повторений теста
             Select Case intTestNo
                Case 1 ' Первая тестируемая Процедура или Функция
                    vVal = Round(lngIteration * 23.56, 3)
                Case 2 ' Вторая ... - и т.д
                    vVal = Format(lngIteration * 21.33, "# ##0.00")
                 Case 3 ' ...
                    vVal = Fix(lngIteration * 23.56)
                Case 4
                    vVal = Int(lngIteration * 23.56)
            End Select
        Next lngIteration
        
    ' Отчет по исполненному тесту :
        sglTimerEnd = Timer
        vVal = ElapsedTimeInSec(sglTimerStart, sglTimerEnd) ' время исполнения строкой + & " (" & vVal & ")"
        sReport = Format(intTestNo, "00") & ". "
        sReport = sReport & strTestName & String(54 - Len(strTestName), ".")
        sReport = sReport & " Продолжительность: " & vVal
        Debug.Print sReport
    Next intTestNo ' к следующему ...
    
    Debug.Print String(90, "-") & "/" ' Линия разделения (результатов)

SpeedCompare_End:
    Screen.MousePointer = 1 ' Вернуть нормальный курсор
    Exit Sub

SpeedCompare_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub :" & _
        "SpeedCompare - mod01SpeedTest.", vbCritical, "Error!"
    Resume SpeedCompare_End
End Sub

Private Function ElapsedTimeInSec(sglTimerStart As Single, Optional ByVal sglTimerEnd!, _
                                  Optional blnLongFormat As Boolean) As String
' es 22.04.2024 v001
' Функция рассчитывает разницу между таймерами с точностью до миллисекунд
' Возвращает отформатированную строку продолжительности формата: "#,##0.000 сек." или  "hh:nn:ss.000"
' Основана на Timer()- Поэтому пригодна для измерений длящихся не более 12 часов! (обычно так и есть)
' --------------------------------------------------------------------------------------------------
' Аргументы:
'   <sglTimerStart> - Значение Timer() на начало измерения
'   <glTimerEnd>    - (Опционально) Значение Timer() на конец измерения - По умолчанию = Timer()
'   <blnLongFormat> - (Опционально) Результат в коротком (0.000 сек.) или длинном формате "hh:nn:ss.000"
' --------------------------------------------------------------------------------------------------
'Пример эксплуотации:
'Dim sglTimerStart As Single, sglTimerEnd As Single ' <sglTimerEnd!> - опционально)
'    sglTimerStart = Timer ' Timer начала (дробные секунды (Single) прошедшие с начала суток)
'    ' инструкции ...
'    sglTimerEnd = Timer 'Timer окончательный (опционально - ибо само ...)
'    Debug.Print "Общая продолжительность: " & ElapsedTimeInSec(sglTimerStart, sglTimerEnd)
' --------------------------------------------------------------------------------------------------
Dim sglTookSeconds!, datTookDays As Date, sglMS As Single
Const csglSecondsPerDay As Single = 86400 ' Секунд в сутках
' Проверка и заполнение второго аргумента и призвоение ему значения
    If sglTimerEnd = 0 Then sglTimerEnd = Timer
' Допустим: Случился перевод даты на замере и Timer пошел с нуля
    If sglTimerEnd < sglTimerStart Then
        ' Проделжительность в секундах (дробное)
        sglTookSeconds = (csglSecondsPerDay - sglTimerStart) + sglTimerEnd
    Else
        sglTookSeconds = sglTimerEnd - sglTimerStart ' Проделжительность в секундах (дробное)
    End If
    
'Форматирование результата по аргументу <blnLongFormat>
    If blnLongFormat = False Then ' Вывод в коротком формате: "0.000 сек."
        ElapsedTimeInSec = Format(sglTookSeconds, "#,##0.000") & " сек."
    Else                          ' Вывод в длинном формате: "hh:nn:ss.000"
        datTookDays = DateAdd("s", sglTookSeconds, Date)
        sglMS = sglTookSeconds - DatePart("s", datTookDays)
        ElapsedTimeInSec = Format$(datTookDays, "hh:nn:ss") & "." & Format$(sglMS * 1000, "0")
     End If
End Function

Назад ToTop
L.E. 18.10.2024
Рейтинг@Mail.ru