زمن قياس تنفيذ الكود او المساعدة بتسريع التنفيذ

[fwares]

السلام عليكم

اود ان اطرح سوالا وارجو من المختصين مساعدتي بدلي على مقالات او حلول 

قمت بتصميم برنامج يقوم بعمليا ت معقدة وجميلة ويتعامل مع عدد كبير من حقول النص (540) مربع نص تقريبا ضمن خوارزمية وعدد من الحلقات المتداخلة

النتيجة راااااااااااااائعة للغاية 

 ولكن المشكلة هي ان زمن التنفيذ طويل نوعا ما وخاصة ان البرنامج على الشبكة 

اود ان استفسر عن طريقة لقياس سرعة تنفيذ مجموعة من العمليات لمعرفة مكان العملية التي تستغرق زمن طويل وخاصة انني لا استطيع قياس العملية بالكامل بطرق تقليدية لوجود حلقات 

 

هل هناك طريقة تحلل الكود وتعطي كل عملية الزمن لتنفيذها؟؟؟

 

وقمت بارفاق الكود لعله يوجد طريقة لتسريع التنفيذ

Public Sub Occup(weekdate1, weekdate2, weekdate3, selDate1, seldate2, seldate3)
Dim week(1 To 3)
Dim daa(1 To 3)
week(1) = weekdate1
week(2) = weekdate2
week(3) = weekdate3
daa(1) = selDate1
daa(2) = seldate2
daa(3) = seldate3
    Dim strsql As String
    Dim rst
    Dim Noo As Integer

For PP = 1 To 3

Form_Loading.Label2.Width = Form_Loading.Label1.Width / 3 * PP
Me("Tog" & week(PP)).Value = -1

'selDate = selDate + PP - 1

    
    
    strsql = "SELECT Occup.ID, Occup.courseID, Occup.courseNa, Occup.trainer, Occup.roomID, Occup.room, Occup.frmdate, Occup.toDate, Occup.timID, Occup.timFrm, Occup.TimTo, Occup.DayID,  Occup.Status, Occup.dayweek " & _
"FROM Occup " & _
"WHERE (((Occup.DayID) = " & week(PP) & "))ORDER BY Occup.ID;"
    '
    Set rst = CurrentDb.OpenRecordset(strsql)
   Noo = 0

    For N = 1 To 13
    Ro = DLookup("Room", "Room", "RoomID = " & N)
    Me("Ro" & PP & Ro) = DLookup("Room", "Room", "RoomID = " & N)
    Me("da" & PP & Ro) = DLookup("day", "dday", "Dayid =" & (week(PP)))
    
    For emp = 1 To 14
       Me("ocp" & PP & Ro & emp).Visible = True
       Me("ocp" & PP & Ro & emp).Width = wdStan.Width
        Me("ocp" & PP & Ro & emp) = ""
        Me("ocp" & PP & Ro & emp).BackColor = 16777215
         Me("ocp" & PP & Ro & emp).ForeColor = 0
        Me("Ocp" & PP & Ro & emp).FontSize = 12
    Next emp
    
    Next N
   
    
    If rst.RecordCount > 0 Then
    While Not rst.EOF
  
  rst.MoveNext
  Noo = Noo + 1
Wend
rst.MoveFirst


    For I = 1 To Noo
        Ro = DLookup("Room", "Room", "RoomID = " & rst!RoomID)
        
        CourseNm = DLookup("SchName", "Newcourse", "Id =" & rst!courseID) 
        
        If chRoomId = rst!RoomID And ChdayID = rst!DayID And chtimeID = rst!timID - 1 And chcourseID = rst!courseID Then
        repNo = repNo + 1
        Me("Ocp" & PP & Ro & rst!timID).Visible = False
        Me("Ocp" & PP & Ro & (rst!timID - repNo)).Width = wdStan.Width * (repNo + 1) + (60 * repNo)
        
       Else
        Me("Ocp" & PP & Ro & rst!timID) = CourseNm
        Me("Ocp" & PP & Ro & rst!timID).Tag = rst!Id
        
        repNo = 0
       End If
        Me("Ocp" & PP & Ro & rst!timID).BackColor = Nz(DLookup("CourseColor", "cName", "courseName ='" & DLookup("courseNa", "Newcourse", "Id =" & rst!courseID) & "'"), 15570276)
        chRoomId = rst!RoomID
        ChdayID = rst!DayID
        chtimeID = rst!timID
        chcourseID = rst!courseID
        
    rst.MoveNext
    Next I
    repNo = 0
    End If
    
rst.Close
   Noo = 0
strsql = "SELECT OneCan.canID, OneCan.CancourID, OneCan.canDate, OneCan.canroomID, OneCan.canDayID, OneCan.cantimID " & _
"FROM OneCan " & _
"WHERE (((OneCan.canDate) = #" & Format(daa(PP), "mm  dd  yyyy") & "#)) ORDER BY OneCan.canID ;"


   
    Set rst = CurrentDb.OpenRecordset(strsql)
     If rst.RecordCount > 0 Then
    While Not rst.EOF
  
  rst.MoveNext
  Noo = Noo + 1
Wend
   rst.MoveFirst
    For I = 1 To Noo
        Ro = DLookup("Room", "Room", "RoomID = " & rst!canroomID)
        
        CourseNm = "Cancel" & DLookup("SchName", "Newcourse", "Id =" & rst!CancourID) 
        

        Me("Ocp" & PP & Ro & rst!cantimID) = CourseNm ' اسم مربع النص
        Me("Ocp" & PP & Ro & rst!cantimID).Tag = rst!canID
        

        Me("Ocp" & PP & Ro & rst!cantimID).BackColor = 2237106
        Me("Ocp" & PP & Ro & rst!cantimID).ForeColor = 15792895
        
        Me("Ocp" & PP & Ro & rst!cantimID).FontSize = 10
        
    rst.MoveNext
    Next I
    
    End If

    rst.Close
        chRoomId = 0
        ChdayID = 0
        chtimeID = 0
        chcourseID = 0
    Noo = 0
    strsql = "SELECT excpDate.excpID, excpDate.courseID, excpDate.excpDate, excpDate.roomID, excpDate.DayID, excpDate.timID " & _
"FROM excpDate " & _
"WHERE (((excpDate.excpDate) = #" & Format(daa(PP), "mm  dd  yyyy") & "#)) ORDER BY excpDate.excpID;"

   
    Set rst = CurrentDb.OpenRecordset(strsql)
     If rst.RecordCount > 0 Then
    While Not rst.EOF
  
  rst.MoveNext
  Noo = Noo + 1
Wend
   rst.MoveFirst
    For I = 1 To Noo
        Ro = DLookup("Room", "Room", "RoomID = " & rst!RoomID)
        
        CourseNm = "Exp" & DLookup("SchName", "Newcourse", "Id =" & rst!courseID) ' & " " & Left(DLookup("courseSubNa", "Newcourse", "Id =" & rst!courseID), 5) & " " & DLookup("trainer", "Newcourse", "Id =" & rst!courseID)
        
        If chRoomId = rst!RoomID And ChdayID = rst!DayID And chtimeID = rst!timID - 1 Then
        repNo = repNo + 1
        Me("Ocp" & PP & Ro & rst!timID).Visible = False
        Me("Ocp" & PP & Ro & (rst!timID - repNo)).Width = wdStan.Width * (repNo + 1) + (60 * repNo)
        
       Else
        Me("Ocp" & PP & Ro & rst!timID) = CourseNm
        Me("Ocp" & PP & Ro & rst!timID).Tag = rst!excpID
        
        repNo = 0
       End If
        Me("Ocp" & PP & Ro & rst!timID).BackColor = Nz(DLookup("CourseColor", "cName", "courseName ='" & DLookup("courseNa", "Newcourse", "Id =" & rst!courseID) & "'"), 15570276)
        chRoomId = rst!RoomID
        ChdayID = rst!DayID
        chtimeID = rst!timID
        
    rst.MoveNext
    Next I
    
    End If

 rst.Close
Next PP
MsgBox "Done"

End Sub

 

[fwares]

ياجماعة الخير مساعدة لوجهة الله

[jjafferr]

وعليكم السلام

 

تفضل:

لقياس سرعة تنفيذ المجموعة 1
....كود
t = timer
....كود
t1 = timer - t    ' الوقت بالثواني
....كود
لقياس سرعة تنفيذ المجموعة 2
....كود
t = timer
....كود
t2 = timer - t    ' الوقت بالثواني
....كود

.

هكذا ، t1 و t2 و ... يعطوك وقت تنفيذ كل مجموعة

ولكن اخذ اكثر من قراءة واحدة لكل مجموعة ، ثم اخذ المعدل.

 

جعفر