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

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

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

Модуль:

' -------------------------------------------------------------------------------------------------/
' Name:     modASpeedTest
' Kind:     Module
' Purpose:  Cравнение работы процедур или функций по скорости
' Author:   es
' Date:     25.05.2023
' -------------------------------------------------------------------------------------------------/
Option Compare Database
Option Explicit

Private Sub SpeedCompare()
' es - 10.05.2022 - LE 25.05.2023 v005
' Процедура для сравнения работы процедур или функций по скорости
' Пишет результат в Immediate Window
' -------------------------------------------------------------------------------------------------/
' ***************************************************** Установка количества повторений теста:
                                                        Const сlngIterations As Long = 1000000
' -------------------------------------------------------------------------------------------------/
Dim intTestNo As Integer        ' Номер теста (1, 2 ... )
Dim lngIteration As Long        ' Счетчик повторений
Dim strTestName As String       ' Название процедуры|функции - для отчёта в Immediate Window
Dim datTimerStart As Date       ' Время начала выполнения
Dim datTimerEnd As Date         ' Время окончания выполнения
' -------------------------------------------------------------------------------------------------/
Dim vVal, strVal$
On Error GoTo SpeedCompare_Err

'Запуск тестов
    For intTestNo = 1 To 4      ' Кол-во тестов - "тестируемых"
        
        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
        
        Screen.MousePointer = 11                      ' Курсор = часы ...
        datTimerStart = Date + CDate(Timer / 86400)   ' Время начала
        
        For lngIteration = 1 To сlngIterations        ' Старт повторений теста
            
            vVal = RandomNo(1, сlngIterations) 'генератор случайных чисел (опционально)
              
            Select Case intTestNo
                Case 1 ' Первая тестируемая Процедура или Функция
                    vVal = Round(vVal * 23.56, 3)
                Case 2 ' Вторая ... - и т.д
                    vVal = Format(vVal * 21.33, "# ##0.00")
                 Case 3 ' ...
                    vVal = Fix(vVal * 23.56)
                Case 4
                    vVal = Int(vVal * 23.56)
            End Select
        Next lngIteration
    
    'Отчет по исполненному тесту :
        datTimerEnd = Date + CDate(Timer / 86400)
        strVal = ElapsedTimeStr(datTimerStart, datTimerEnd) ' время исполнения строкой
        strVal = "Тест: " & intTestNo & " - (" & Format$(сlngIterations, "#,##0") & _
                 " повторов) - Продолжительность: " & strVal
        'Название теста  (если указано)
        If Len(strTestName) > 0 Then strVal = strVal & " - " & strTestName
        Debug.Print strVal
        DoEvents 'Лёгкий "передых" системе
    Next intTestNo 'Один тест закончен  - к следующему ...
    
    Debug.Print String(100, "-") ' Линия разделения (результатов)

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

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

' =================================================================================================
' + Вспомогательные функции:
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 Function RandomNo(lMinVal&, lMaxVal&) As Long
' Генератор случайных чисел - Возвращает случайное число  от lMinVal до lMaxVa
    Randomize ' Инициализация генератора
    RandomNo = Int(lMinVal + (Rnd() * lMaxVal))
End Function

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