معادلة ترتيب الاوائل بوجود تكرار

[rofa97]

ارجو المساعده فى ملف لترتيب الاوائل بوجود تكرار

لان عند وجود تكرار مثلا الاول مكرر لا يحسب الثاني ويكتب الثالث

[ابراهيم الحداد]

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

يمكنك استخدام هذه الدالة المعرفة

و هى تعطى الترتيب من الاول حتى العاشر فقط مع التكرار

Function RRank(Cel As Range, Rang As Range) As String
 'Cel   : اول خلية فى نطاق الدرجات
 ' Rang : -F4- النطاق الذى سوف يتم البحث فيه ويجب تثبيته باستخدام مفتاح
'----------------------

Dim Obj As Object, I As Long, Arr As Variant
Dim temp As Variant, Itm As Variant, Rnk As Integer
Dim x As Integer, k As Integer, MK As String, xx As String

  '================
  
Set Obj = CreateObject("Scripting.Dictionary")
Arr = Rang.Value
For Each Itm In Arr
If Obj.exists(Itm) Then
Obj.Item(Itm) = Obj.Item(Itm) + 1
Else
Obj.Add Itm, 1
End If
Next
temp = Obj.keys
I = Obj.Count
  '================
If I <= 10 Then
k = I
Else: k = 10
End If
For n = 1 To k
Rnk = WorksheetFunction.Large(temp, n)
If Cel.Value = Rnk Then
If n >= 1 And n <= 10 Then
xx = Choose(n, "الاول", "الثانى", "الثالث", "الرابع", "الخامس", _
"السادس", "السابع", "الثامن", "التاسع", "العاشر")
trb = xx
Else
trb = ""
End If
End If
Next

 '=================
 
m = WorksheetFunction.CountIf(Range(Rang.Cells(1, 1), Cel), Cel)
If m > 1 And Cel.Value >= Rnk Then
MK = " مكرر"
Else
MK = ""
End If

 '=================
 
RRank = trb & MK

End Function

 

[ابراهيم الحداد]

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

للاسف على قدر علمى ان هذا الامر يحتاج الى اعمدة مساعدة كثيرة

على العمود الدالة المعرفة بالمشاركة السابقة تعمل عمل المعادلات 

فقط تحتاج حفط الملف بامتداد XLSM مثلا

هذا و الله اعلى و اعلم

[rofa97]

جزاك الله كل خير اخي الكريم