Bài viết: Các phương pháp để đo thời gian thực thi mã lệnh trong VB/VBA

[Nguyễn Duy Tuân]

Có nhiều bạn nhiều khi tranh luận hay so sánh về một hàm hay thủ tục này nhanh hay chậm hơn những cái khác. Nhiều khi sự so sánh có vẻ hơi cảm tính. Chúng ta hãy dùng cách đơn giản và khoa học để đo về tốc độ thực hiện của một hàm hay thủ tục.

Hàm Timer có thể dùng để xác định thời gian khi mà việc kiểm soát thời gian không quá khắt khe.

Khi cần kiểm tra sự dịch chuyển thời gian mà mức thay đổi lên đến 1/1000 giây (1 millisecond - mili giây) thì cần dùng các hàm API.
Có thể liệt kê các hàm đo thời gian như sau:

Now, Time, Timer (thuộc VB/VBA)
GetTickCount
TimeGetTime
QueryPerformanceCounter, QueryPerformanceFrequency


Chúng ta sẽ cùng thực hiện một loạt các thử nghiệm dưới đây sẽ có kết luận.
Với mỗi thủ tục test dưới đây là một phương pháp đo thời gian thực hiện mã lệnh.

Trong VB/VBA, đầu Module khai báo các hàm API

Declare Function QueryPerformanceCounter Lib "Kernel32" _
                        (X As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                        (X As Currency) As Boolean
Declare Function GetTickCount Lib "Kernel32" () As Long
Declare Function timeGetTime Lib "winmm.dll" () As Long

Hàm Timer

Sub Test_Timer()
    '
    ' Timer Function
    '
    Dim Loops&, T1&, T2&
    Debug.Print
    Loops = 0
    T1 = Timer
    Do
      T2 = Timer
      Loops = Loops + 1
    Loop Until T1 <> T2
   
    Debug.Print "Timer minimum resolution: "; _
                (T2 - T1); "second(s)"
    Debug.Print "Took"; Loops; "loops"

End Sub

Sau khi chạy kết quả là:
Timer minimum resolution: 1 second(s)
Took 2190162 loops

Nghĩa là, với hàm Timer thời gian chỉ thay đổi sau mỗi 1 giây và phải mất 2190162 vòng lặp mới biết được (số liệu này còn phụ thuộc ta làm gì trong vòng lặp).


Hàm GetTickCount

Sub Test_GetTickCount()
    '
    ' GetTickCount API Function
    '
    Dim Loops&, T1&, T2&
    Debug.Print
    Loops = 0
    T1 = GetTickCount
    Do
      T2 = GetTickCount
      Loops = Loops + 1
    Loop Until T1 <> T2
   
    Debug.Print "GetTickCount minimum resolution: "; _
                (T2 - T1); "millisecond(s)"
    Debug.Print "Took"; Loops; "loops"

End Sub

Sau khi chạy kết quả là:
GetTickCount minimum resolution: 16 millisecond(s)
Took 219874 loops

Nghĩa là, với hàm GetTickCount kiểm tra thời gian thay đổi sau mỗi 16 mili giây (16/1000 giây) và mất 219 874 vòng lặp mới biết được sự thay đổi.

Như vậy hiểu một cách đơn giản là sai số trong Timer là 1000 thì với GetTickCount là 16/1000.


Hàm timeGetTime

Sub Test_timeGetTime()
    '
    ' timeGetTime API Function
    '
    Dim Loops&, T1&, T2&
    Debug.Print
    Loops = 0
    T1 = timeGetTime
    Do
      T2 = timeGetTime
      Loops = Loops + 1
    Loop Until T1 <> T2
   
    Debug.Print "timeGetTime minimum resolution: "; _
                (T2 - T1); "millisecond(s)"
    Debug.Print "Took"; Loops; "loops"

End Sub

Sau khi chạy kết quả là:
timeGetTime minimum resolution: 1 millisecond(s)
Took 14034 loops

Nghĩa là, với hàm timeGetTime kiểm tra thời gian thay đổi sau mỗi 1 mili giây (1/1000 giây) và mất 14 034 vòng lặp để biết được sự thay đổi.

Như vậy hiểu một cách đơn giản là sai số trong GetTickCount là 16/1000 thì timeGetTime chỉ là 1/1000 (đương nhiên là chính xác hơn Timer rất nhiều).

Hàm QueryPerformanceCounter

Private Sub Test_QueryPerformanceCounter()
    '
    ' QueryPerformanceFrequency API Function
    ' QueryPerformanceCounter API Function
    '

    Dim Loops&, T1@, T2@, Freq@, Overhead@, I&
  
    QueryPerformanceFrequency Freq
    QueryPerformanceCounter T1
    QueryPerformanceCounter T2
    Overhead = T2 - T1       
    QueryPerformanceCounter T1 
    
    Do
      QueryPerformanceCounter T2
      Loops = Loops + 1
    Loop Until T1 <> T2
    
    Debug.Print (T2 - T1 - Overhead) / Freq * 1000; "milliseconds(ms)"
    Debug.Print "Took"; Loops; "loops"
  
End Sub

Sau khi chạy kết quả là:
0.000279 milliseconds(ms)
Took 1 loops
Mức kiểm soát thời gian tuyệt vời!!!

Nghĩa là, với hàm QueryPerformanceCounter kiểm tra thời gian thay đổi sau mỗi 0.000279
mili giây và chỉ mất 1 vòng lặp để biết được sự thay đổi.

Như vậy hiểu một cách đơn giản là sai số trong QueryPerformanceCounter là 0.000279/1000 thì timeGetTime là 1/1000.


Tổng hợp lại ta có thể đánh giá về độ chính xác đo thời gian thực thi cũa mã lệnh như sau:

Now, Time, Timer (thuộc VB/VBA) kém nhất vì resolution = 1 giây
GetTickCount kém nhì vì resolution = 16 mili giây (tốt hơn Timer rất nhiều)
TimeGetTime kém thứ ba vì resolution = 1 mili giây
QueryPerformanceCounter là tốt nhất


Các ví dụ test ở trên tôi dựa vào tài liệu của Microsoft và có chỉnh sửa một chút cho phù hợp. Số liệu đo của các thủ tục test chỉ mang tính tương đối dùng làm cơ sở để dễ so sánh.

Một số bài viết có liên quan:
1/ Tổng quan về FileSystemObject (phần 1)
2/ [Gỡ rối VBA] Lỗi vòng lặp lặp vô tận - Lỗi từ vòng lặp
3/ Hàm để lấy chỉ số màu trong các ô đã Conditional Formatting
4/ Xếp một trường theo một trật tự màu quy định trước
5/ Sử dụng Name trong VBA
6/ Viết code để nhìn thấy ai là người cập nhật bảng tính của bạn lần gần đây nhất
7/ 3 gợi ý nhỏ mang lại thành công trong khai báo biến trong VBA
8/ Tổng quan về Scripting.Dictionary
9/ Khi nào nên sử dụng Msgbox, Inputbox và Userform?
10/ Làm thế nào để thay thế các chữ OK, CANCEL,... nhàm chán của Msgbox

 

[duongcga]

High resolution timer: phải đc CPU hỗ trợ thì mới có mà xài, ko phải CPU nào cũng có, do đó trước khi dùng phải kiểm tra xem CPU có hỗ trợ ko đã.