问题
I am trying to test the execution time differences between data types after looping through 1 million random numbers per data type (integer, double, decimal, and variant). I took this code from the Microsoft Developer website. I am using Excel 2010.
Here is the code:
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
This code gives me errors such as:
Compile error:
Only comments may appear after End Sub, End Function, or End Property
EDIT: Here is the improved version of the code, which has no compile errors, but I'm not sure how to integrate the timer into my functions.
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
EDIT: New VBA code (did I set up this function properly?)
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:
Add a new class module to your project, call it PerformanceMonitor and paste this code from the thread I linked to in my comment into the class:
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
Now as an example of how to use it, you need to declare and create an instance of the PerformanceMonitor class, then call its StartCounter method at the start of the code you want to time, then at the end call its TimeElapsed property to see how long it took (in milliseconds). For example:
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
来源：https://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working