كود العشر الأوائل

[قنديل الصياد]

قمت بإضافة هذا الكود فى ملف به درجات بعض الطلاب وعمل الكود بامتياز

ولما تم نقل الكود الى ملف اخر للطلاب يعمل ايضا بكفاءة ولكن سبب بطئ فى التعامل مع باقى الصفحات وتنفذ باقى الاكواد الموجودة بالملف ولكن بثقل شديد جدا مع العلم اننا لو حذفنا هذا الكود من الملف يرجع الى طبيعته الاولي وتعمل جميع اكواده بكفاءة عالية

فما الحل

مرفق الكود

Function TOPTEN(Mark_Table As Range, Cer_Table As Range, RNK As Integer, True_False As Boolean)
Application.ScreenUpdating = False
Dim Rw, i, k As Long
Dim CON As Integer
Dim HOS
Dim ARR
Dim SS
Dim M
Dim S
TOPTEN = "#N/A"
'-------------------------------------------------------------------
If True_False = True Then
ARR = Array("", "الأول", "الثاني", "الثالث", "الرابع" _
, "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر", "الحادى عشر", "الثانى عشر", "الثالث عشر", "الرايع عشر", "الخامس عشر", "السادس عشر", "السابع عشر", "الثامن عشر", "التاسع عشر", "العشرون", "الواحد والعشرون", "الثانى والعشرون", "الثالث والعشرون", "الرابع والعشرون", "الخامس العشرون", "السادس والعشرون", "السابع العشرون", "الثامن والعشرون", "التاسع والعشرون", "الثلاثون", "الواحد وثلاثون", "الثانى والثلاثون", "الثالث والثلاثون", "الرابع والثلاثون", "الخامس والثلاثون", "السادس والثلاثون", "السابع والثلاثون", "الثامن والثلاثون", "التاسع والثلاثون", "الأربعون", "الواحد وأربعون", "الثانى والأربعون", "الثالث والأربعون", "الرابع والأربعون", "الخامس والأربعون", "السادس والأربعون", "السابع والأربعون", "الثامن والأربعون", "التاسع والأربعون", "الخمسون ")
If WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK)) <> 1 Then
For i = 1 To RNK
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, i) Then Val1 = Val1 + 1
If Val1 = 2 Then
SS = " مكرر": RNK = i - 1: Exit For
End If
Next i
End If
10 TOPTEN = ARR(RNK) & SS
Exit Function
End If
'-------------------------------------------------------------------
For Rw = 1 To Mark_Table.Rows.Count
If WorksheetFunction.Large(Mark_Table, RNK) = Mark_Table.Cells(Rw, 1) Then
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK))
If CON = 0 Then
TOPTEN = Cer_Table.Cells(Rw, 1).TeCONt
Exit Function
End If
If CON <> 0 Then
M = M + 1: S = 0
For k = 1 To RNK
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, k) Then S = S + 1
Next k
If S = M Then
TOPTEN = Cer_Table.Cells(Rw, 1).Value
Exit Function
End If
End If
End If
Next Rw
Application.ScreenUpdating = True
End Function

[سليم حاصبيا]

 نفس الملف لكن بالمعادلات

اعلى عشر طلاب.rar

[قنديل الصياد]

اخى العزيز شكرا على الملف الجميل

ولكن نريد هذا الكود لانه يقوم بترتيب الفصل كاملا بخلاف انه يرتب الطلاب المتساوون فى المجموع الى اول ثم اول مكرر وهكذا

[قنديل الصياد]

للرفع

[ياسر خليل أبو البراء]

أخي الحبيب وأستاذنا الكبير قنديل الصياد

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

ولا يمكن في هذه الحالة تحديد المشكلة ...

ممكن ترفق الملف الذي تعمل عليه حتى تتضح الفكرة أكثر

تقبل تحياتي

[قنديل الصياد]

شكرا استاذنا الحبيب على الاهتمام

دا الملف

 

Copy of الصياد.rar

 

[قنديل الصياد]

للرفع

[قنديل الصياد]

للرفع

[قنديل الصياد]

مرفوع