Cách đo tốc độ thực hiện của một thủ tục hoặc hàm (3 người xem)

[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.
Có thể có nhiều cách nhưng tôi xin đưa ra một cách là dùng hàm API GetTickCount.

Trong VBA, ở đầu Module khai báo:

Declare Function GetTickCount Lib "kernel32" () As Long

Trong thủ tục làm như sau

 Sub DoThoiGian() 
    'Đầu thủ tục gán
    T1 = GetTickCount 'Nhận nhịp đếm thời gian bắt đầu
     ....
     ....Các lệnh xử lý
     ....
     'Cuối thủ tục gán
    T2 = GetTickCount 'Nhận nhịp đếm thời gian kết thúc
    MsgBox (T2 - T1) / 1000, vbInformation, "Số giây đã thực hiện là"
End Sub

Hy vọng phương pháp trên giúp các bạn một phần cách kiểm tra mã lệnh tối ưu về thời gian.

 GetTickCount      

The GetTickCount function retrieves the number of milliseconds that have elapsed since Windows was started. 

DWORD GetTickCount(VOID)
 

Parameters

This function has no parameters. 

Return Values

If the function succeeds, the return value is the number of milliseconds that have elapsed since Windows was started. 

Remarks

The elapsed time is stored as a DWORD value. Therefore, the time will wrap around to zero if Windows is run continuously for 49.7 days. 
Windows NT: To obtain the time elapsed since the computer was started, look up the System Up Time counter in the performance data in the registry key HKEY_PERFORMANCE_DATA. The value returned is an 8 byte value.

Đọc thêm:

http://msdn2.microsoft.com/en-us/library/ms724408.aspx

http://www.vbforums.com/showthread.php?t=231183

 

[SA_DQ]

(ảm ơn Tuấn Nhiều, nhiều lắm

(ho hỏi thêm TuanVNUNI câu sau;

 [b]Sub DinhThoi()[/b]
  Dim TGian
 
  TGian = Timer
   [My  Code]
   . . . 
   [My code]
   Msgbox Str(Timer -TGian)
 [b] End Sub [/b]

Có những nhược điểm gì so với hàm Tuấn nêu, ngoài việc nó thực thi chậm hơn không?

 

[Nguyễn Duy Tuân]

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

(ho hỏi thêm TuanVNUNI câu sau;

 [b]Sub DinhThoi()[/b]
  Dim TGian
 
  TGian = Timer
   [My  Code]
   . . . 
   [My code]
   Msgbox Str(Timer -TGian)
 [b] End Sub [/b]

Có những nhược điểm gì so với hàm Tuấn nêu, ngoài việc nó thực thi chậm hơn không?

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 vong 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.

Các bạn có thể tìm hiểu thêm tại đây:
http://support.microsoft.com/kb/172338

Chúc các bạn ngày đầu tuần thành công!

 

[SoiBien]

Tôi thấy đoạn code này cũng có thể tính tới ms (còn hơn nữa, sau dấu chấm dài lắm.

[color=darkblue]Sub[/color] testtime()
[color=darkblue]Dim[/color] startt, endt
startt = Now()
[color=green]' Your code here[/color]
endt = Now()
MsgBox (endt - startt) * 24 * 60 * 60 * 1000 & " ms"
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Vậy có khác biệt không bạn Tuan ơi, so với sử dụng các hàm API? độ chính xác chẳng hạn?
Thân mến.

 

[LearnMore]

Tôi thấy đoạn code này cũng có thể tính tới ms (còn hơn nữa, sau dấu chấm dài lắm.

[COLOR=darkblue]Sub[/COLOR] testtime()
[COLOR=darkblue]Dim[/COLOR] startt, endt
startt = Now()
[COLOR=green]' Your code here[/COLOR]
endt = Now()
MsgBox (endt - startt) * 24 * 60 * 60 * 1000 & " ms"
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Vậy có khác biệt không bạn Tuan ơi, so với sử dụng các hàm API? độ chính xác chẳng hạn?
Thân mến.

Chung qui cái này độ chính xác cũng xấp xỉ 1 giây mà bác SoiBien.

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.

Em thấy sửa 1000 thành 1000/1000 = 1 s mới đúng.

LM

 

[SoiBien]

Chung qui cái này độ chính xác cũng xấp xỉ 1 giây mà bác SoiBien.

Không hiểu ý Learn More! Ý LM là nó chỉ hiện đơn vị làm tròn đến 1s thôi hả? Mình thấy nó hiển thị chính xác làm bao nhieu ms luôn đấy chứ! Bác có chạy thử chưa?)

 

[Nguyễn Duy Tuân]

Test_Now

Tôi thấy đoạn code này cũng có thể tính tới ms (còn hơn nữa, sau dấu chấm dài lắm.

[color=darkblue]Sub[/color] testtime()
[color=darkblue]Dim[/color] startt, endt
startt = Now()
[color=green]' Your code here[/color]
endt = Now()
MsgBox (endt - startt) * 24 * 60 * 60 * 1000 & " ms"
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Vậy có khác biệt không bạn Tuan ơi, so với sử dụng các hàm API? độ chính xác chẳng hạn?
Thân mến.

Hàm Now cũng như hàm Timer bạn ạ. Có nghĩa là không nên dùng trong những yêu cầu kiểm tra khắt khe về thời gian.

Sub Test_Now()
    '
    ' Now Function
    '
    Dim Loops&, T1, T2
    Debug.Print
    Loops = 0
     
    T1 = Format(Now, "mm:ss.000")
    Do
      T2 = Format(Now, "mm:ss.000")
      Loops = Loops + 1
      'Debug.Print "Took"; Loops; "loops"
    Loop Until T1 <> T2
    
    Debug.Print "T1= ", T1
    Debug.Print "T2= ", T2
                
    Debug.Print "Took"; Loops; "loops"

End Sub

Kết quả là:

T1= 10:04.000
T2= 10:05.000
Took 180168 loops


Hàm Now, thời gian chỉ thay đổi sau mỗi 1 giây (giống hàm Timer) và phải mất 180168 vòng lặp mới biết được.
Mặc dù Now và Timer giống nhau về số giây nhưng khác nhau về số vòng lặp mà thủ tục test thực hiện được. Hàm Timer số vòng lặp thực hiện được là 2190162 ; còn hàm Now là 180168 như vậy chứng tỏ hàm Timer quét thời gian liên tục hơn hàm Now-->Nên dùng hàm Timer hơn Now (cùng kém cả ).

 

[smbsolutions]

Google: clsBenchmark + Visual basic
Cụ thể là: http://www.freevbcode.com/ShowCode.Asp?ID=190

Có những clsBenchmark được viết từ những năm 9x và 100% những code đó dùng API. Khỏi thắc mắc làm gì vì các hàm Date, Time, Now, v.v.. gì đó trong VB Library đều là wraper các APIs của libraries của Windows.

Ví dụ về clsBenchmark

'// Initialise
Set objBenchMark = New clsBenchmark

objBenchMark.start
'// Long code here

objBenchMark.Finish
Msgbox objBenchMark.ElapsedTime & " second(s)." '// Dĩ nhiên là kết quả ra dạng miliseconds rồi chứ ai lại tính theo giây.

Những món này họ đúc kết từ lâu lắm rồi (những năm 9x). Search về dùng và nó thôi. Hầu hết 99,9% code giải quyết những thứ common như trên đều có thể google được (toàn free code).

Tập chung thời gian giải quyết vấn đề ít gặp hơn hoặc lớn hơn mang tính chất kiến trúc ứng dụng, tính thiết kế, v.v...

 

[smbsolutions]

Tuân gửi email cho admin của VietRose, xin đăng ký lấy 1 account. (trên diễn đàn có hướng dẫn gửi thông tin đăng ký đó). Trên đó có rất nhiều thứ để tìm hiểu về món mà Tuân đang băn khoăn.

Để có thiết kế tốt, đầu tiên phải có tài liệu đặc tả yêu cầu tốt đã. Vì thế trước khi quan tâm tới món thiết kế người ta quan tâm trước tới món yêu cầu (ở dạng tài liệu chứ ko ở trong đầu).

Khi viết món đó, người ta có cách viết tài liệu để sao cho dân design có thể đọc hiểu được. Nhiều người trong giới IT hay đùa rằng "khách hàng" của đội viết tài liệu đặc tả là dân thiết kế (và dân test). Khách hàng của dân thiết kế là tụi coders, khách hàng của tụi coders...

Tuân thử nghiên cứu OOAD trên ngôn ngữ UML và làm thử qua Rational Rose xem sao.

 

[dhtt]

Thân chào anh Tuấn và gia đình GPE! Nhân đây em cũng có 1 vấn đền cần nhờ giúp đỡ như sau:
+ Em có 1 đoạn Code gồm nhiều thủ tục xử lý dữ liệu, nếu chạy đoạn Code này thì mất khoảng 3-5 phút và hơn thế nữa. Cho em hỏi có cách gì khi chạy Code này sẽ hiện lên thước đo tỉ lệ % tương ứng với thời gian Code đã thực
+ Khi chạy xong Code thì hiện lên thông báo là đã hoàn tất công việc ( VD: Đã phân tích xong vật tư!)

 

[Nguyễn Duy Tuân]

Thân chào anh Tuấn và gia đình GPE! Nhân đây em cũng có 1 vấn đền cần nhờ giúp đỡ như sau:
+ Em có 1 đoạn Code gồm nhiều thủ tục xử lý dữ liệu, nếu chạy đoạn Code này thì mất khoảng 3-5 phút và hơn thế nữa. Cho em hỏi có cách gì khi chạy Code này sẽ hiện lên thước đo tỉ lệ % tương ứng với thời gian Code đã thực
+ Khi chạy xong Code thì hiện lên thông báo là đã hoàn tất công việc ( VD: Đã phân tích xong vật tư!)

Bạn có thể làm theo cách này

Sub Test()
    Dim I As Long, nMax As Long
    
    For I = 1 To nMax
        Application.StatusBar = "Xin hay doi..." & Round((I / nMax) * 100, 0) & "%"
        'Code chay
    Next I
    
End Sub

 

[TrungChinhs]

Mình Test nhưng không thấy gì cả. Bạn nào Test được pot cho mình xin File Test nhé. Thanks !

 

[Nguyễn Duy Tuân]

Mình Test nhưng không thấy gì cả. Bạn nào Test được pot cho mình xin File Test nhé. Thanks !

Bác test cái gì ạ? Em không hiểu ý bác.

 

[TrungChinhs]

@ TuanVNUNI Mình thả một Sub của mình vào đoạn code chạy để xem nó có hiện % trên StatusBar không ?

Sub Test()
Dim I As Long, nMax As Long

For I = 1 To nMax
Application.StatusBar = "Xin hay doi..." & Round((I / nMax) * 100, 0) & "%"
'Code chay
Next I

End Sub

 

[Nguyễn Duy Tuân]

@ TuanVNUNI Mình thả một Sub của mình vào đoạn code chạy để xem nó có hiện % trên StatusBar không ?

Sub Test()
Dim I As Long, nMax As Long

For I = 1 To nMax
Application.StatusBar = "Xin hay doi..." & Round((I / nMax) * 100, 0) & "%"
'Code chay
Next I

End Sub

Cái Code chay là của lệnh thực thi của chương trình. Ví dụ như tính tổng chẳng hạn.

[COLOR="Green"]'Ví dụ tính tổng ở cột A từ dòng 1->5000[/COLOR]
Sub Test()
    Dim I As Long, nMax As Long
    Dim nSum As Double
    nMax = 5000
    For I = 1 To nMax
        Application.StatusBar = "Xin hay doi..." & Round((I / nMax) * 100, 0) & "%"
        [COLOR="Green"]'Code chay[/COLOR]
[COLOR="Red"]        If IsNumeric(Cells(I, 1).Value) Then
            nSum = nSum + Cells(I, 1).Value
        End If[/COLOR]
    Next I
    MsgBox "Tổng là: " & nSum
End Sub

From DHTT:
Cảm ơn anh Tuấn nhiều!

 

[syquyen1987]

Em xin chào mọi người,
Em có một vấn đề mà chưa giải quyết được mong mọi người giúp em với.
Em có các ô B2: B16 theo thứ tự có giá trị chuỗi từ HT1 đến HT15. Nhưng khi em dùng code sau sắp xếp ngược lại (theo thứ tự từ Z đến A) để muốn kết quả từ HT15 đến HT1 như sau Range("B2:B16").Sort [B2], xlDescending, Header:=xlNo
Kết quả lại không được như mong muốn như sau:
HT9 HT8 HT7 HT6 HT5 HT4 HT3 HT2 HT14 HT13 HT12 HT11 HT10 HT1

Có cách nào để sắp xếp như mong muốn không ạ, mong mọi người chỉ giúp em với

Em xin chân thành cám ơn

 

[syquyen1987]

Declare Function GetTickCount Lib "kernel32" () As Long

Sao dùng cái này thì máy tính mình thì chạy được, chuyển sang máy tính khác là bị lỗi không chạy được vậy