VBA QueryPerformanceCounter 不工作

Question

在循环遍历每种数据类型(整数、 double 、十进制和变量)的 100 万个随机数后，我试图测试数据类型之间的执行时间差异。我从 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

这段代码给了我错误，例如:

Compile error:

Only comments may appear after End Sub, End Function, or 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

Answer 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