VBA kodunun çalışma süresini nasıl test edersiniz?


95

VBA'da bir işlevi sarmalayabileceğim bir kod var mı, bu kodun çalışması için geçen süreyi bana bildirir, böylece işlevlerin farklı çalışma sürelerini karşılaştırabilir miyim?

Yanıtlar:


82

İşlevleriniz çok yavaş olmadıkça, çok yüksek çözünürlüklü bir zamanlayıcıya ihtiyacınız olacak. Bildiğim en doğru olanı QueryPerformanceCounter. Daha fazla bilgi için Google'da arayın. Bu çağrı bir sınıfa aşağıdaki iterek deneyin CTimersonra bir örneği yere küresel yapabilir derler ve sadece aramak .StartCounterve.TimeElapsed

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

2
Bunu Excel VBA'da uyguladım (bu KB makalesinde belirtildiği gibi Ek yüke ekledim: support.microsoft.com/kb/172338 . Harika çalıştı. Teşekkürler.
Lance Roberts

2
Teşekkürler, bu benim için de iyi çalışıyor. TimeElapsed()sonucu milisaniye cinsinden verir. Mükemmel doğruluktan ziyade genel gider hesaplamasında kekemeliğin etkisi konusunda endişelendiğim için herhangi bir genel gider tazminatı uygulamadım.
Justin

2
Bu çok fazla kulak misafiri oldu (yönetilecek kod satırlarında) - ~ 10ms doğrulukla yaşayabilirseniz, @ Kodak'ın aşağıdaki cevabı aynı şeyi bir satır kodda verir ( GetTickCountkernel32'den içe aktararak ).
BrainSlugs83

StartCounterVe nasıl kullanıyorsunuz TimeElapsed? CTimerBaşlangıçta bir Timer örneği yaptım ve With StartCountersadece abonem .StartCounterbaşladıktan sonra yazdım .TimeElapsedve bana cevap verdi Invalid use of property. Bir yana bıraktığımda .StartCounter, bana bir nesnenin ayarlanmadığını söylüyor.
Monica için Revolucion

Excel 2010 için: Declare PtrSafe Function stackoverflow.com/questions/21611744/…
user3226167

49

VBA'daki Zamanlayıcı işlevi, gece yarısından bu yana geçen saniye sayısını saniyenin 1 / 100'üne kadar verir.

Dim t as single
t = Timer
'code
MsgBox Timer - t

18
Bu işe yaramaz - ortalamayı böyle alarak daha fazla çözüm elde edemezsiniz.
Andrew Scagnelli

4
Yine de, VBA'da performansı ölçüyorsanız, saniyenin 1 / 100'ünü elde etmek fena değil. - Zamanlama çağrılarını tek başına çağırmak birkaç ms sürebilir. Arama o kadar hızlıysa, zamanlamak için o kadar çok çözünürlüğe ihtiyacınız varsa, muhtemelen o arama hakkında performans verilerine ihtiyacınız yoktur.
BrainSlugs83

1
notlar: Mac'te Zamanlayıcı yalnızca bir saniyeye kadar doğrudur - ve bu, gece yarısından önce başlar ve gece yarısından sonra biterse negatif sayılar alabilir
TmTron

32

Zamanı bir kronometre gibi döndürmeye çalışıyorsanız, sistem başlangıcından bu yana geçen zamanı milisaniye olarak döndüren aşağıdaki API'yi kullanabilirsiniz:

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub testTimer()
Dim t As Long
t = GetTickCount

For i = 1 To 1000000
a = a + 1
Next

MsgBox GetTickCount - t, , "Milliseconds"
End Sub

http://www.pcreview.co.uk/forums/grab-time-milliseconds-included-vba-t994765.html'den sonra (winmm.dll'deki timeGetTime benim için çalışmadığından ve QueryPerformanceCounter gereken görev için çok karmaşık olduğundan)


Bu harika bir cevap. Not: döndürülen verilerin kesinliği milisaniye cinsindendir, ancak sayaç, MSDN aracılığıyla yalnızca saniyenin 1 / 100'ü kadar doğrudur (yani, 10 ila 16 ms arasında olabilir): msdn.microsoft.com / tr-tr / library / windows / desktop /…
BrainSlugs83

hmm, burada çözünürlük Zamanlayıcı ile aynıysa, o zaman Zamanlayıcı ile giderim
Kodak

Bölüm nedir Public Declare Function ...? Kodunuzu benim alt
kısmıma

Bu kamuya açık bildirimi modülünüzün en üstüne taşımanız gerekiyor
Kodak


3
Sub Macro1()
    Dim StartTime As Double
    StartTime = Timer

        ''''''''''''''''''''
            'Your Code'
        ''''''''''''''''''''
    MsgBox "RunTime : " & Format((Timer - StartTime) / 86400, "hh:mm:ss")
End Sub

Çıktı:

Çalışma Süresi: 00:00:02



0

2 ondalık boşluk içeren saniye:

Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime) / 1000000, "#,##0.00") & " seconds") 'end timer

saniye biçimi

Milisaniye:

Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime), "#,##0.00") & " milliseconds") 'end timer

milisaniye biçimi

Virgül ayırıcılı milisaniye:

Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime) * 1000, "#,##0.00") & " milliseconds") 'end timer

Virgül ayırıcılı milisaniye

Bunu, benim gibi saniye ila 2 ondalık boşlukla biçimlendirilmiş basit bir zamanlayıcı arayan herkes için burada bırakıyorum. Bunlar, kullanmayı sevdiğim kısa ve tatlı küçük zamanlayıcılar. Alt veya işlevin başında yalnızca bir satır kod alırlar ve sonunda yine bir satır kod alırlar. Bunların çılgınca doğru olması amaçlanmamıştır, genellikle kişisel olarak saniyenin 1 / 100'ünden daha azını umursamıyorum, ancak milisaniye zamanlayıcısı size bu 3'ün en doğru çalışma süresini verecektir. Ayrıca sizi okudum Nadir bir durum olan ancak FYI olan gece yarısı geçerken koşarsa yanlış okumayı alabilir.


Zamanlayıcı 10ms çözünürlüğe sahip olduğundan yalnızca ilki kullanışlıdır.
Gustav
Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.