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?
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:
İş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 CTimer
sonra bir örneği yere küresel yapabilir derler ve sadece aramak .StartCounter
ve.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
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.
GetTickCount
kernel32'den içe aktararak ).
StartCounter
Ve nasıl kullanıyorsunuz TimeElapsed
? CTimer
Başlangıçta bir Timer örneği yaptım ve With StartCounter
sadece abonem .StartCounter
başladıktan sonra yazdım .TimeElapsed
ve bana cevap verdi Invalid use of property
. Bir yana bıraktığımda .StartCounter
, bana bir nesnenin ayarlanmadığını söylüyor.
Declare PtrSafe Function
stackoverflow.com/questions/21611744/…
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
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)
Public Declare Function ...
? Kodunuzu benim alt
Yeni arılar için, bu bağlantılar, zamanını izlemek istediğiniz tüm denizaltıların otomatik bir profillemesinin nasıl yapılacağını açıklar:
http://www.nullskull.com/a/1602/profiling-and-optimizing-vba.aspx
http://sites.mcpher.com/share/Home/excelquirks/optimizationlink içinde procProfiler.zip bkz http://sites.mcpher.com/share/Home/excelquirks/downlable-items
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
Yıllarca milisaniye doğruluğu için winmm.dll'de timeGetTime tabanlı bir çözüm kullandık. Bkz. Http://www.aboutvb.de/kom/artikel/komstopwatch.htm
Makale Almanca'dır, ancak indirmedeki kod (dll işlev çağrısını saran bir VBA sınıfı) makaleyi okuyamadan kullanmak ve anlamak için yeterince basit.
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
Milisaniye:
Dim startTime As Single 'start timer
MsgBox ("run time: " & Format((Timer - startTime), "#,##0.00") & " milliseconds") 'end timer
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
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.