VBA QueryPerformanceCounter 不工作答案

【问题标题】：VBA QueryPerformanceCounter Not WorkingVBA QueryPerformanceCounter 不工作
【发布时间】：2015-10-01 16:56:51
【问题描述】：

在循环遍历每种数据类型（整数、双精度、十进制和变量）的 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

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

编译错误：

只有 cmets 可以出现在 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

【问题讨论】：

那是 VB.Net 代码，不是 VBA。
仅供参考您的基准测试类型，但很少声明它们。 dim a,b as T 仅将 b 声明为 T。
我建议你阅读这个：stackoverflow.com/questions/198409/…
@AlexK。我一直在告诉人们错误的编程语言？哦，好吧。
@Rory 我已经使用该计时器添加了新版本的代码。你能告诉我如何将此计时器集成到我的宏中吗？谢谢。

标签： vba excel excel-2010

【解决方案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

【讨论】：

谢谢，我添加了该代码并调整了我的函数以包含该计时器中需要进入的部分。如何声明+创建一个 PerformanceMonitor 类，然后调用 TimeElapsed？我想我理解其他部分。
我已经添加了我的函数来替换你的第二个示例函数（见上文，第三个代码块）。
看起来不错 - 你有问题吗？
那部分代码运行良好。如何将此代码放在一个类中，然后调用该方法？我正在阅读这个ramblings.mcpher.com/Home/excelquirks/snippets/classes，但它对我来说似乎很技术性，它是为初学者准备的。
这就是你在上面做的。如果它有效，您必须将代码放入一个类中。