VBA QueryPerformanceCounter不起作用
我试图在循环每个数据types（整数，双精度，十进制和variables）的一百万个随机数之后testing数据types之间的执行时间差异。 我从微软开发者网站上获取了这段代码。 我正在使用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代码（我设置了这个function吗？）
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
将一个新的类模块添加到您的项目中，将其称为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
现在作为如何使用它的一个例子，你需要声明和创build一个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