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

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

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

Модуль:

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

Private Sub SpeedCompare()
' es - 10.05.2022 - LE 27.01.2024 v06
' Процедура для сравнения работы процедур или функций по скорости
' Пишет результат в Immediate Window
' -------------------------------------------------------------------------------------------------/
Const сiTotTests As Integer = 4 ' Установка количества тестов ("тестируемых" процедур или функций)
Const сlngIterations As Long = 1000000 ' Установка количества повторений теста
Const iMaxLen As Integer = 55
' -------------------------------------------------------------------------------------------------/
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$ ', lRandomVal&
On Error GoTo SpeedCompare_Err
    
    Screen.MousePointer = 11         ' Курсор = часы ...
    
    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
        
        
        datTimerStart = Date + CDate(Timer / 86400)   ' Время начала
        
        For lngIteration = 1 To сlngIterations        ' Старт повторений теста
            
            'lRandomVal = RandomNo(1, с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
        
    'Отчет по исполненному тесту :
        datTimerEnd = Date + CDate(Timer / 86400)
        vVal = ElapsedTimeStr(datTimerStart, datTimerEnd) ' время исполнения строкой
    
        If intTestNo = 1 Then 'Заголовок
            strVal = "Тест из " & Format$(сlngIterations, "#,##0") & " повторов:" & vbCrLf
        Else
            strVal = ""
        End If
        
        strVal = strVal & Format(intTestNo, "00") & ". "
        strVal = strVal & strTestName & String(iMaxLen - Len(strTestName), ".")
        strVal = strVal & " Продолжительность: " & vVal
        Debug.Print strVal
    Next intTestNo ' к следующему ...
    
' -------------------------------------------------------------------------------------------------/
    DoEvents
    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!"
    '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 до lMaxVal
    Randomize ' Инициализация генератора
    RandomNo = Int(lMinVal + (Rnd() * lMaxVal))
End Function
Назад ToTop
L.E. 27.01.2024
Рейтинг@Mail.ru