Bagaimana Anda menguji waktu berjalan kode VBA?

95

Apakah ada kode di VBA yang dapat saya gabungkan dengan suatu fungsi yang akan memberi tahu saya waktu yang dibutuhkan untuk menjalankannya, sehingga saya dapat membandingkan waktu berjalan yang berbeda dari fungsi?

Lance Roberts
sumber

Jawaban:

81

Kecuali jika fungsi Anda sangat lambat, Anda memerlukan pengatur waktu dengan resolusi sangat tinggi. Yang paling akurat yang saya tahu adalah QueryPerformanceCounter. Google itu untuk info lebih lanjut. Coba dorong perintah berikut ke dalam kelas, sebut saja CTimer, lalu Anda dapat membuat instance di suatu tempat secara global dan cukup panggil .StartCounterdan.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
Mike Woodhouse
sumber
2
Saya menerapkan ini di Excel VBA (menambahkan Overhead seperti yang disebutkan dalam artikel KB ini: support.microsoft.com/kb/172338 . Ini bekerja dengan baik. Terima kasih.
Lance Roberts
2
Terima kasih, ini juga bekerja dengan baik untuk saya. TimeElapsed()memberikan hasilnya dalam milidetik. Saya tidak menerapkan kompensasi overhead apa pun karena saya lebih khawatir tentang efek gagap dalam perhitungan overhead daripada akurasi yang sempurna.
Justin
2
Itu banyak yang terdengar (dalam baris kode untuk dikelola) - jika Anda dapat hidup dengan akurasi ~ 10ms, jawaban @ Kodak di bawah ini memberikan hal yang sama dalam satu baris kode (mengimpor GetTickCountdari kernel32).
BrainSlugs83
Bagaimana Anda menggunakan StartCounterAnd TimeElapsed? Saya melakukan Timer contoh CTimerdi awal dan With StartCountersaya hanya menulis .StartCountersetelah sub saya mulai dan .TimeElapseddan itu menjawab saya Invalid use of property. Ketika saya biarkan .StartCountersaja itu memberi tahu saya sebuah objek tidak disetel.
Revolucion untuk Monica
Untuk excel 2010: Declare PtrSafe Function stackoverflow.com/questions/21611744/…
pengguna3226167
48

Fungsi Timer di VBA memberi Anda jumlah detik yang berlalu sejak tengah malam, hingga 1/100 detik.

Dim t as single
t = Timer
'code
MsgBox Timer - t
dbb
sumber
18
Itu tidak akan berhasil - Anda tidak bisa mendapatkan resolusi lebih dari mengambil rata-rata seperti itu.
Andrew Scagnelli
4
Namun, jika Anda mengukur kinerja dalam VBA, mendapatkan 1/100 resolusi detik tidaklah buruk. - Memanggil panggilan waktu saja bisa memakan waktu beberapa md. Jika panggilan sangat cepat sehingga Anda memerlukan resolusi sebanyak itu untuk mengatur waktunya, Anda mungkin tidak memerlukan data kinerja tentang panggilan itu.
BrainSlugs83
1
catatan: di Mac, Timer hanya akurat untuk satu detik - dan ini mungkin mendapatkan angka negatif jika dimulai sebelum tengah malam dan berakhir setelah tengah malam
TmTron
32

Jika Anda mencoba mengembalikan waktu seperti stopwatch, Anda dapat menggunakan API berikut yang mengembalikan waktu dalam milidetik sejak sistem dimulai:

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

setelah http://www.pcreview.co.uk/forums/grab-time-milliseconds-included-vba-t994765.html (karena timeGetTime di winmm.dll tidak berfungsi untuk saya dan QueryPerformanceCounter terlalu rumit untuk tugas yang diperlukan)

Memotret dgn kodak
sumber
Ini jawaban yang bagus. Catatan: itu ketepatan data yang dikembalikan adalah dalam milidetik, namun, penghitung hanya akurat sekitar 1/100 detik (yaitu, bisa dimatikan 10 hingga 16 ms) melalui MSDN: msdn.microsoft.com / en-us / library / windows / desktop /…
BrainSlugs83
hmm, jika resolusinya di sini sama dengan Timer maka saya akan menggunakan Timer
Kodak
Apakah yang Public Declare Function ... bagiannya? Ini menciptakan kesalahan saat menambahkan kode Anda di bagian bawah saya
Revolucion untuk Monica
Anda perlu memindahkan pernyataan publik ini ke bagian atas modul Anda
Kodak
3
Sub Macro1()
    Dim StartTime As Double
    StartTime = Timer

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

Keluaran:

RunTime: 00:00:02

Gajendra Santosh
sumber
2

Kami telah menggunakan solusi berdasarkan timeGetTime di winmm.dll untuk akurasi milidetik selama bertahun-tahun. Lihat http://www.aboutvb.de/kom/artikel/komstopwatch.htm

Artikelnya dalam bahasa Jerman, tetapi kode dalam unduhan (kelas VBA yang membungkus panggilan fungsi dll) cukup sederhana untuk digunakan dan dipahami tanpa bisa membaca artikel.

Tom Juergens
sumber
0

Detik dengan 2 spasi desimal:

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

format detik

Milidetik:

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

format milidetik

Milidetik dengan pemisah koma:

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

Milidetik dengan pemisah koma

Tinggalkan ini di sini untuk siapa saja yang mencari pengatur waktu sederhana yang diformat dengan detik hingga 2 spasi desimal seperti saya. Ini adalah timer kecil yang pendek dan manis yang suka saya gunakan. Mereka hanya mengambil satu baris kode di awal sub atau fungsi dan satu baris kode lagi di akhir. Ini tidak dimaksudkan untuk menjadi sangat akurat, saya biasanya tidak peduli tentang apa pun yang kurang dari 1/100 detik secara pribadi, tetapi pengatur waktu milidetik akan memberi Anda waktu berjalan paling akurat dari 3 ini. Saya juga telah membaca Anda bisa mendapatkan pembacaan yang salah jika kebetulan berjalan saat melintasi tengah malam, hal yang jarang terjadi tetapi hanya FYI.

teknisi23
sumber
Hanya yang pertama yang berguna, karena Timer memiliki resolusi 10ms.
Gustav