كود لتحديد الطلاب الأوائل

[mamdohsaid]

برجاء  كود  

لتحديد  الطلاب  الأوائل من   الأول  إلى  العاشر

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

الأخ الكريم ممدوح سيد

أهلاً بك في المنتدى

يرجى مراجعة رابط التوجيهات في الموضوعات المثبتة في المنتدى كما يرجى تغيير اسم الظهور للغة العربية

قم بضغط ملفك ثم ارفقه ليساعدك الاخوة الأعضاء على المطلوب

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

تقبل تحياتي

[mamdohsaid]

الأستاذ  الفاضل  :  شكرا  جزيلا  على  اهتمامك 

مرفق  نموذج  للشيت 

برجاء  تحديد  الأوائل  تلقائيا  بكود    وليس  عن  طريق  الفرد 

وفي  حالة  تساوي  الدرجات  تكون  المرجعية  للسن

ويكتب  للطالب  التالي  كلمة  مكرر  كما هو موضح  بالجدول 

 

 

كما  أرجو  معرفة  كيفية  عمل  رسالة  لإدخال  كلمة  سر لفتح  البرنامج  

مع  إمكانية  تعديلها  من  أي  مستخدم  آخر  للبرنامج  عن طريق كتابة كلمة السر القديمة   ثم تعديلها بكلمة سر جديدة 

ولكم  جزيل  الشكر

كنترول ممدوح للمرحلة الإعدادية .rar

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

صراحة المطلوب غير واضح إلى حد ما .. يرجى وضع بعض النتائج المتوقعة ليسهل التعامل مع الملف

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

أخي الحبيب يرجى وضع النتائج المتوقعة ..

ويا ريت ترفق النتائج بعيداً على الشيت الأصلي يعني أنا وضعت لك درجات وهمية في ورقة العمل "أوائل التيرم الأول" في عمود المجموع وحاولت يكون فيه تشابه في المجاميع ..وفي عمود الاسم وضعت تواريخ ميلاد عشان أعرف منك شكل النتائج المتوقعة خصوصاً في حالة تشابه تواريخ الميلاد

أنتظر منك إرفاق النتائج المتوقعة في عمود الترتيب بشكل دقيق .. لن أعمل مرتين على الملف (بقالي ساعة جنب الملف)

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

الاخ الكريم ممدوح

يبدو أنك لم تستجب لطلبي ... لا غيرت اسم الظهور للغة العربية ولا أرفقت النتائج المتوقعة كما طلبت منك

عموماً إليك هذا الكود عله يفي بالغرض

يتم ترتيب الطلاب على أساس الدرجة فإذا تساوى الطلاب في الدرجة يتم الاحتساب على أساس تاريخ الميلاد فإذا تساوى الطلاب في الدرجة وتاريخ الميلاد يكتب كلمة مكرر ...

Sub TopTenYasserKhalil()
  Dim Cell As Range, shTemp As Worksheet, ArrRanks
  ArrRanks = Array("الأول", "الثاني", "الثالث", "الرابع", "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر")

  Application.ScreenUpdating = False
  Set shTemp = Sheets.Add

    With Sheets("الرصد")
      Intersect(Union(.Columns("E"), .Columns("G"), .Columns("H"), .Columns("DQ")), .Rows("12:" & .UsedRange.Rows.Count)).Copy
    End With
    With shTemp.Range("A2")
      .PasteSpecial xlPasteValues
      .CurrentRegion.Sort Key1:=.Columns("D"), Order1:=xlDescending, _
                          Key2:=.Columns("C"), Order2:=xlAscending, _
                          Header:=xlNo
      With .Parent.Range("E2:E11")
        For Each Cell In .Cells
            With Cell
              If (.Offset(0, -1).Value = .Offset(-1, -1).Value) And (.Offset(0, -2).Value = .Offset(-1, -2).Value) Then
                 .Value = .Offset(-1).Value
              Else
                 .Value = .Offset(-1).Value + 1
              End If
            End With
        Next Cell
        For Each Cell In .Cells
            With Cell
              .Value = ArrRanks(.Value - 1)
              If .Value = .Offset(-1).Value Then .Value = .Value & " مكرر"
            End With
        Next Cell
      End With
      With .Parent
        .Columns("C").Delete xlShiftToLeft
        .Range("A2:D11").Copy
        Sheets("أوائل التيرم الأول ").Range("G11").PasteSpecial (xlPasteValues)
      End With
    End With

  Application.DisplayAlerts = False
    shTemp.Delete
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

كل عام وأنت بخير :gift2:

كنترول ممدوح للمرحلة الإعدادية .rar

[احمد الطحان]

رائع

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

ولك جزيل الشكر

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

بارك الله فيك أخي الكريم أحمد

يرجى التوضيح ..يعني ايه بالاسم والمجموع

[احمد الطحان]

الترتيب حسب المجموع فاذا تساوى فى المجموع يكون على ابجدة الاسماء

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

يرجى طرح موضوع جديد بطلبك ليستفيد منه الجميع

تقبل تحياتي