حساب الوقت المنقضي بعد تنفيذ الكود Calculate Elapsed Time After Executing Code

السلام عليكم ورحمة الله وبركاته

إليكم كود يقوم بحساب الوقت المنقضي بعد تنفيذ كود معين ، ويفيد الكود في حالة إذا ما كان لديك أكثر من كود يؤدي نفس الغرض وأردت معرفة الكود الأسرع في التنفيذ للاعتماد عليه.

يوجد في بداية الكود أسطر للإعلان عن API وهي مطلوبة لتحقيق المطلوب لمعرفة الوقت المنقضي في تنفيذ الكود ، يليها دالة معرفة UDF وظيفتها إرجاع الوقت المنقضي بالاعتماد على دوال API.

يوجد في الكود إجراء فرعي باسم GenerateTestData يقوم بإنشاء مصفوفة بالبيانات لحرفي X و Y ثم يتم وضع البيانات في عدد 100 ألف صف (عدد كبير من الصفوف لتجربة كود التوقيت) ، ومن المعلوم أن 100 ألف يعد حجم هائل للبيانات (إذا كان لك خبرة في التعامل مع الحلقات التكرارية جرب أن تقوم بنفس المهمة باستخدام الحلقات التكرارية ولاحظ الفرق في التوقيت بنفسك)

آخر جزء في الكود هو الإجراء الفرعي المسمى Main_Proc والذي من خلاله يتم استدعاء الإجراء الفرعي الذي يولد بيانات عشوائية في العمود الأول والثاني ثم يحسب الوقت الذي استغرقه الكود في التنفيذ.

يمكنك استخدام الكود ببساطة بأن تضع اسم الإجراء الفرعي الخاص بك بين أقواس تنصيص في هذا السطر .. أي بدلاً من كلمة GenerateTestData تضع اسم الإجراء الفرعي الخاص بك والذي تريد معرفة الوقت المستغرق في تنفيذه

Application.Run "GenerateTestData"

وأخيراً إليكم الكود المستخدم

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If

Function MicroTimer() As Double
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency
    getTickCount cyTicks1
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Private Sub GenerateTestData()
    Dim Data(1 To 100000, 1 To 2)
    Dim I As Long
    
    Rnd -5
    For I = 1 To UBound(Data)
        If Rnd >= 0.5 Then Data(I, 1) = "X"
        If Rnd >= 0.5 Then Data(I, 2) = "Y"
    Next I

    Cells.ClearContents
    Range("A1").Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub

Sub Main_Proc()
    Dim dTime As Double
    dTime = MicroTimer()
    
    'Call The Procedure You Need To Calculate The Time Elapsed
    Application.Run "GenerateTestData"
    
    MsgBox CStr(Round(MicroTimer - dTime, 5)) & " Seconds"
End Sub

تحميل الملف من هنا

إعداد / ياسر خليل أبو البراء