Пользовательская функция MicroTimer предназначена для более точного определения времени работы процедур VBA Excel, чем с помощью функции Timer.
Функция MicroTimer
Пользовательская функция MicroTimer позволяет более точно определять время работы процедур и отдельных участков кода VBA Excel, чем функция Timer.
Объявление функций Windows API
Код объявления функций Windows API «getFrequency» и «getTickCount» для вставки в раздел «Declarations» модуля VBA Excel:
|
1 2 |
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long |
Если у вас 64-разрядная версия приложения Excel, добавьте ключевое слово PtrSafe:
|
1 2 |
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long |
Код функции MicroTimer
Код пользовательской функции MicroTimer для размещения в любом месте программного модуля ниже раздела «Declarations»:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
Function MicroTimer() As Double Dim cyTicks1 As Currency Static cyFrequency As Currency 'Обнуление МикроТаймера MicroTimer = 0 'Получение частоты, равной количеству тактов («тиков») 'таймера, встроенного в процессор, в секунду If cyFrequency = 0 Then getFrequency cyFrequency 'Получение количества тактов («тиков») таймера с полуночи 'до текущего времени getTickCount cyTicks1 'Вычисление количества секунд, прошедших с полуночи, где 'количество секунд = количество тактов / частота If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency End Function |
Частота встроенного в процессор таймера – постоянная величина, зависящая только от вашего процессора. Узнать эту частоту можно с помощью следующего кода (функция Windows API «getFrequency» уже должна быть объявлена в разделе Declarations):
|
1 2 3 4 5 |
Sub FrequencyTimer() Dim cyFrequency As Currency getFrequency cyFrequency MsgBox cyFrequency End Sub |
Код определения времени
Шаблон кода VBA Excel для определения времени работы процедур и отдельных участков кода с помощью функции MicroTimer:
|
1 2 3 4 5 6 7 8 |
Sub VremyaRabotyMakrosa() Dim StartTime As Double, ElapsedTime As Double StartTime = MicroTimer '--- Здесь размещаем тестируемый код или ссылку на процедуру --- ElapsedTime = MicroTimer - StartTime 'Вывод времени работы кода, например, через MsgBox MsgBox ElapsedTime End Sub |
Переменные:
- StartTime – значение функции MicroTimer перед началом работы тестируемого кода.
- ElapsedTime – время работы тестируемого кода в секундах.
Пример кода с MicroTimer
Пример кода VBA Excel для сравнения точности измерения времени работы цикла For… Next с помощью функций Timer и MicroTimer:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
Sub VremyaRabotyMakrosa() Dim t As Single, i1 As Long, i2 As Long, n As Long, m As Double Dim StartTime As Double, ElapsedTime As Double For i1 = 1 To 3 n = 10 ^ i1 * 1000 Cells(1, i1) = "n = " & n 'Функция Timer m = 0 t = Timer For i2 = 1 To n m = m + i2 Next t = Timer - t Cells(2, i1) = t & " Timer" 'Функция MicroTimer m = 0 StartTime = MicroTimer For i2 = 1 To n m = m + i2 Next ElapsedTime = MicroTimer - StartTime Cells(3, i1) = CDec(ElapsedTime) & " MicroTimer" Next End Sub |
Значение переменной ElapsedTime преобразуется в тип данных Decimal (CDec), чтобы значение меньше единицы не преобразовывалось автоматически в экспоненциальную форму.
Один из результатов работы кода:
Как видно на скриншоте, при количестве итераций цикла 10000 и 100000, определить время выполнения цикла с помощью функции Timer не удалось.
Здравствуйте, Евгений!
Здравствуйте, коллеги!
Что-то MicroTimer не вызвал доверия:
getFrequency возвращает не верную частоту процессора (у меня).
И самое непонятное в getTickCount: дробные части Count’ов не равномерно распределены в (0;0,(9)) – есть проседание в (0;0,1) и подъём в (0,1;0,(3)), далее до 0,(9) вроде ожидаемо равномерно. Код, который показывает это:
Option ExplicitDeclare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Sub hh()
Dim i&, TmrDig@, s0&, s1&, s2&, s3&
s0 = 0: s1 = 0: s2 = 0: s3 = 0
For i = 0 To 111111111 '11
getTickCount TmrDig
' TmrDig = TmrDig * 100
TmrDig = TmrDig - Int(TmrDig)
If TmrDig < 1 / 3 Then s0 = s0 + 1 Else If TmrDig < 2 / 3 Then s1 = s1 + 1 Else s2 = s2 + 1
' If TmrDig < 0.25 Then s0 = s0 + 1 Else If TmrDig < 0.5 Then s1 = s1 + 1 Else If TmrDig < 0.75 Then s2 = s2 + 1 Else s3 = s3 + 1
' If TmrDig < 0.1 Then s0 = s0 + 1 Else s1 = s1 + 1
Next
Debug.Print i, Round(s0 / i, 3), Round(s1 / i, 3), Round(s2 / i, 3), Round(s3 / i, 3)
End Sub
P.S. не по теме. Забрёл я сюда в надежде слепить из MicroTimer'а генератор последовательности истинно, не псевдо, случайных чисел. Что оказалось невозможным здесь. Прошу совета, как сделать (или где взять) искомый генератор.
Обсуждение закрыто.