VBA QueryPerformanceCounter не работает

Я пытаюсь проверить разницу во времени выполнения между типами данных после цикла через 1 миллион случайных чисел для каждого типа данных (целое, двойное, десятичное и вариантное). Я взял этот код с веб-сайта Microsoft Developer. Я использую Excel 2010.VBA QueryPerformanceCounter не работает

Вот код:

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

EDIT: Вот это улучшенная версия кода, который имеет нет ошибок компиляции, но я не уверен, как интегрировать таймер в мои функции.

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: Новый код 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

источник

2015-07-13 Thomas Shera

Это код VB.Net, а не VBA. –

FYI - ваши контрольные типы, но редко их объявляют. 'dim a, b as T' только объявляет' b' как 'T'. –

Предлагаю вам прочитать следующее: http://stackoverflow.com/questions/198409/how-do-you-test-running-time-of-vba-code – Rory

Добавить новый модуль класса в ваш проект, назовем его 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

источник

2015-07-13 15:08:22 Rory

Спасибо, я добавил этот код и адаптировал мою функцию, чтобы включить части этого таймера, которые нужно зайти в него. Как объявить + создать класс PerformanceMonitor, а затем вызвать TimeElapsed? Я думаю, что я понимаю другие части. –

Я добавил свою функцию, которая заменяет вашу вторую примерную функцию (см. Выше, третий блок кода). –

Выглядит хорошо - у вас есть проблема с этим? – Rory

VBA QueryPerformanceCounter не работает

ответ

Смежные вопросы