VBA QueryPerformanceCounter не работает
Я пытаюсь проверить разницу во времени выполнения между типами данных после прохождения 1 миллиона случайных чисел на тип данных (целое, двойное, десятичное и вариантное). Я взял этот код с сайта Microsoft Developer. Я использую Excel 2010.
Вот код:
Option Explicit
Sub Function1()
Module Module1
Declare Function QueryPerformanceCounter Lib "Kernel32" (ByRef X As Long) As Short
Declare Function QueryPerformanceFrequency Lib "Kernel32" (ByRef X As Long) As Short
Dim Ctr1, Ctr2, Freq As Long
Dim Acc, I As Integer
' Times 100 increment operations by using QueryPerformanceCounter.
If QueryPerformanceCounter(Ctr1) Then ' Begin timing.
For I = 1 To 100 ' Code is being timed.
Acc += 1
Next
QueryPerformanceCounter (Ctr2) ' Finish timing.
Console.WriteLine ("Start Value: " & Ctr1)
Console.WriteLine ("End Value: " & Ctr2)
QueryPerformanceFrequency (Freq)
Console.WriteLine ("QueryPerformanceCounter minimum resolution: 1/" & Freq & " seconds.")
Console.WriteLine ("100 Increment time: " & (Ctr2 - Ctr1) / Freq & " seconds.")
Else
Console.WriteLine ("High-resolution counter not supported.")
End If
'
' Keep console window open.
'
Console.WriteLine()
Console.Write ("Press ENTER to finish ... ")
Console.Read()
End Module
End Sub
Sub Function1_Int_RandNumCounter()
Dim Int_RandNum_X As Integer
Dim Int_RandNum_Y As Integer
Dim Count As Integer
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Int_RandNum_Y = Rnd(Now)
Next Count
' Call Function1_Dbl_RandNumCounter
End Sub
Sub Function1_Dbl_RandNumCounter()
Dim Dbl_RandNum_X As Double, Dbl_RandNum_Y As Double, Count As Double
For Count = 1 To Count = 1000000
Dbl_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Dbl_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Var_RandNumCounter
End Sub
Sub Function1_Var_RandNumCounter()
Dim Var_RandNum_X, Var_RandNum_Y, Count As Variant
For Count = 1 To Count = 1000000
Var_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Var_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Dec_RandNumCounter
End Sub
Sub Function1_Dec_RandNumCounter()
Dim Count, Var_RandNum_X, dec_RandNum_X, Var_RandNum_Y, dec_RandNum_Y
dec_RandNum_X = CDec(Var_RandNum_X)
dec_RandNum_Y = CDec(Var_RandNum_Y) ' convert these vals to decimals
For Count = 1 To Count = 1000000
dec_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
dec_RandNum_Y = Rnd(Now)
Next Count
Call Function2_BarGraph
End Sub
Sub Function2_BarGraph()
' Put all of these vals in a 2D bar graph
End Sub
Этот код дает мне такие ошибки, как:
Ошибка компиляции:
Только комментарии могут появляться после End Sub, End Function или End Property
РЕДАКТИРОВАТЬ: Вот улучшенная версия кода, в которой нет ошибок компиляции, но я не уверен, как интегрировать таймер в мои функции.
Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double
Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
Low = LI.lowpart
If Low < 0 Then
Low = Low + TWO_32
End If
LI2Double = LI.highpart * TWO_32 + Low
End Function
Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
QueryPerformanceFrequency PerfFrequency
m_crFrequency = LI2Double(PerfFrequency)
End Sub
Public Sub StartCounter()
QueryPerformanceCounter m_CounterStart
End Sub
Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
QueryPerformanceCounter m_CounterEnd
crStart = LI2Double(m_CounterStart)
crStop = LI2Double(m_CounterEnd)
TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property
Sub Function1_Int_RandNumCounter()
Dim Int_RandNum_X As Integer
Dim Int_RandNum_Y As Integer
Dim Count As Integer
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Int_RandNum_Y = Rnd(Now)
Next Count
' Call Function1_Dbl_RandNumCounter
End Sub
Sub Function1_Dbl_RandNumCounter()
Dim Dbl_RandNum_X As Double, Dbl_RandNum_Y As Double, Count As Double
For Count = 1 To Count = 1000000
Dbl_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Dbl_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Var_RandNumCounter
End Sub
Sub Function1_Var_RandNumCounter()
Dim Var_RandNum_X, Var_RandNum_Y, Count As Variant
For Count = 1 To Count = 1000000
Var_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Var_RandNum_Y = Rnd(Now)
Next Count
Call Function1_Dec_RandNumCounter
End Sub
Sub Function1_Dec_RandNumCounter()
Dim Count, Var_RandNum_X, dec_RandNum_X, Var_RandNum_Y, dec_RandNum_Y
dec_RandNum_X = CDec(Var_RandNum_X)
dec_RandNum_Y = CDec(Var_RandNum_Y) ' convert these vals to decimals
For Count = 1 To Count = 1000000
dec_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
dec_RandNum_Y = Rnd(Now)
Next Count
Call Function2_BarGraph
End Sub
Sub Function2_BarGraph()
' Put all of these vals in a 2D bar graph
End Sub
РЕДАКТИРОВАТЬ: новый код VBA (я правильно настроил эту функцию?)
Sub Function1_Int_RandNumCounter()
Dim Int_RandNum_X As Integer
Dim Int_RandNum_Y As Integer
Dim Count As Integer
Dim oPM As PerformanceMonitor
Dim Time_Int As Variant
Time_Int = CDec(Time_Int)
Set oPM = New PerformanceMonitor
oPM.StartCounter
For Count = 1 To Count = 1000000
Int_RandNum_X = Rnd(Now) ' Get rnd vals based on Now, built-in VBA property
Int_RandNum_Y = Rnd(Now)
Next
Time_Int = oPM.TimeElapsed
' Call Function1_Dbl_RandNumCounter
End Sub
1 ответ
Добавьте новый модуль класса в ваш проект, назовите его PerformanceMonitor и вставьте этот код из потока, на который я ссылался в своем комментарии, в класс:
Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double
Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#
Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
Low = LI.lowpart
If Low < 0 Then
Low = Low + TWO_32
End If
LI2Double = LI.highpart * TWO_32 + Low
End Function
Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
QueryPerformanceFrequency PerfFrequency
m_crFrequency = LI2Double(PerfFrequency)
End Sub
Public Sub StartCounter()
QueryPerformanceCounter m_CounterStart
End Sub
Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
QueryPerformanceCounter m_CounterEnd
crStart = LI2Double(m_CounterStart)
crStop = LI2Double(m_CounterEnd)
TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property
Теперь в качестве примера того, как его использовать, вам нужно объявить и создать экземпляр класса PerformanceMonitor, а затем вызвать его StartCounter
метод в начале кода, который вы хотите время, а затем в конце вызова его TimeElapsed
свойство, чтобы увидеть, сколько времени это заняло (в миллисекундах). Например:
Sub foo()
Dim n As Long
Dim oPM As PerformanceMonitor
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 100000
Debug.Print n
Next
MsgBox oPM.TimeElapsed
Set oPM = Nothing
End Sub