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

[فضل حسين]

الى خبراء واعضاء منتداى العزيز والعظيم

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

مرفق ملف موضح به المطلوب وجزاكم الله كل خير

اسماء ودرجات الدور الثانى فقط لاغير.rar

[عبدالله المجرب]

السلام عليكم

على فرض ان الدرجة الصغرى 25

تفضل المرفق

اسماء ودرجات الدور الثانى فقط لاغير.rar

[عبدالله المجرب]

السلام عليكم

انتبهت الى ان الدرجة الصغرى ليست ثابته (25)

هذا التعديل للكود السابق للاخذ بالاعتبار بالدرجة الصغرى

استبدل الكود السابق في الملف بهذا

Sub Abu_Ahmed_2nd()

Dim cl As Range, cel As Range

Set MySh = Sheets("Sheet1")

[D8:I100].ClearContents

For i = 4 To 28

ww = 0

For J = 1 To 5

t = Application.CountIf(MySh.Cells(i, J + 4), "<" & MySh.Cells(3, J + 4))

If t = 1 Then ww = ww + 1

Next

If MySh.Cells(i, 2) = [L2] And MySh.Cells(i, 3) = [L3] And ww >= 1 And ww <= 2 Then

Cells(Range("D1000").End(xlUp).Row + 1, 4) = MySh.Cells(i, 2).Offset(0, -1)

For Each cel In MySh.Range(MySh.Cells(i, 5), MySh.Cells(i, 9))

If cel < MySh.Cells(3, cel.Column) And ww <= 2 Then

Cells(Range("D1000").End(xlUp).Row, cel.Column) = cel

Else: GoTo 2

End If

2 Next

Else: GoTo 1

End If

1 Next

Set MySh = Nothing

End Sub

[Ahmed Elbhiry]

يفتح الله عليك ابواب علمه

[رجب جاويش]

الأخ الفاضل / أبو أحمد

بسم الله ما شاء الله

بجد والله العقل احتار من متابعة هذه الأكواد الرائعة التى تدل على عبقرية فريدة فى التعامل مع الأكواد ربنا يزيدك من علمه وتمتعنا بالمزيد من الأعمال الرائعة حتى نتعلم ونستفيد

[بن علية حاجي]

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

أخي الكريم، وبالمعادلات (حسب الترتيب في العنوان وتتبعا لخطوات أخي الحبيب أبو أحمد) الحل في الملف المرفق...

أخوكم بن علية

اسماء ودرجات الدور الثانى فقط لاغير1.rar

[رجب جاويش]

الأخ الفاضل / بن عليه

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

سلمت يداك

[فضل حسين]

حبيب قلبى المايسترو

استاذى الكبير / بن عليه

سبحان الله والحمد لله ولااله الا الله والله اكبر

محتاج وقت للتجربة لهذا العمل الرائع وفى اقرب فرصة او وقت سوف اقوم بالرد

مع اننى اعرف الرد مسبقا وهو (امتياز مع مرتبة الشرف )

[ناصر سعيد]

الاساتذه الكرام

حرف الغين يعتبر ايضا دور تان

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

[Ahmed Elbhiry]

الاساتذه الكرام

حرف الغين يعتبر ايضا دور تان

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

لماح احسنت

[بن علية حاجي]

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

أخي الكريم، أستسمح أخي الحبيب أبو أحمد في القيام بتغيير في كوده الرائع حسب الطلب الجديد (الطالب الغائب) وفي الملف بالمعادلات تم إضافة هذا الشرط الجديد مع تسمية معادلة جلب علامة الطالب بالتسمية Formule لغرض اختصار المعادلة في الجدول...

أخوكم بن علية

ملف أخي الحبيب أبو أحمد بالكود:

اسماء ودرجات الدور الثانى فقط لاغير.rar

الملف بالمعادلات:

اسماء ودرجات الدور الثانى فقط لاغير2.rar

تم تعديل مارس 9, 2012 بواسطه hben

[عبدالله المجرب]

السلام عليكم

أستسمح أخي الحبيب أبو أحمد في القيام بتغيير في كوده الرائع حسب الطلب الجديد (الطالب الغائب)

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

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

[الزير]

الاستاذان الكريمين

بن عليه

عبدالله المجرب

بارك الله فيكم وزادكم من علمه

ابووائل

[فضل حسين]

_{الثنائى المدهش والخطير}

_{حبيب قلبى المايسترو}

_{المبدع بن علية}

_{عمل اقل مايقال عنه انه يستحق ( امتياز مع مرتبة الشرف ) . انهما حقا الثنائى المدهش بل الثنائى الخطير المايسترو والمبدع بن علية}

_{كنت فاكر اننى محتاج وقت قليل لتجربة او لتطبيق الكود والمعادلات للثنائى المدهش والخطير .الظاهر اننى كنت واهم واكتشفت اننى محتاج اجلس فى البيت وعلى طول وامام منتدى اوفيسنا لمتابعة ودراسة وتطبيق الاعمال الرائعة للثنائى المدهش والخطير .ياالله لك الحمد والشكر .}

_{الثنائى المدهش والخطير}

_{اسمحوا لى امام هذه العظمة والاعمال الرائعة بل امام هذا الجسر الطيرانى من الابداع ( والله انا ماسك الخشب ) ان اطلب من سيادتكم طلب بسيط}

_{ان يظهر فى الحل سواء كان بالكود او بالمعادلات الحالة اى كلمة (دور ثان ) .بمعنى عند الضغط على الكود يظهر الحالة دور ثانى امام الاسم والدرجة وكذلك الحال بالنسبة للمعادلات .}

_{ولسيادتكم كثير من الحب والعرفان . مع الشكر}

[عبدالله المجرب]

السلام عليكم

اخي الزير شكراً لك

====

اخي فضل

ضع هذه المعادلة في الخلية J8 ثم اسحبها للاسفل

=IF(D8<>"";"دور ثان";"")

[فضل حسين]

حبيب قلبى المايسترو

الف شكر وبارك الله فيك وان كنت اتمنى الحالة ( دور ثان ) ان تكون بداخل الكود الرائع الخاص بسيادتكم

لان هذة المعادلة وجدت انها موجودة بالفعل مع معادلات المبدع بن علية

اكرر شكرى لسيادتكم وللمبدع وجزاكم الله كل خير

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

[رجب جاويش]

بعد إذن أخى الفاضل / عبد الله المجرب

قمت باضافة الحالة ( دور ثانى ) داخل الكود الرائع للأستاذ أبو أحمد تلبية لطلب الأخ فضل

اسماء ودرجات الدور الثانى فقط لاغير.rar

[عبدالله المجرب]

الف شكر وبارك الله فيك وان كنت اتمنى الحالة ( دور ثان ) ان تكون بداخل الكود الرائع الخاص بسيادتكم

اخي فضل

سيصبح الكود هكذا

Sub Abu_Ahmed_2nd()

Dim cl As Range, cel As Range

Set MySh = Sheets("Sheet1")

[D8:J100].ClearContents

For i = 4 To 28

ww = 0

For J = 1 To 5

t = Application.CountIf(MySh.Cells(i, J + 4), "<" & MySh.Cells(3, J + 4))

If t = 1 Then ww = ww + 1

Next

If MySh.Cells(i, 2) = [L2] And MySh.Cells(i, 3) = [L3] And ww >= 1 And ww <= 2 Then

Cells(Range("D1000").End(xlUp).Row + 1, 4) = MySh.Cells(i, 2).Offset(0, -1)

Cells(Range("D1000").End(xlUp).Row, 10) = "دور ثان"

For Each cel In MySh.Range(MySh.Cells(i, 5), MySh.Cells(i, 9))

If (cel < MySh.Cells(3, cel.Column) Or cel = "Û") And ww <= 2 Then

Cells(Range("D1000").End(xlUp).Row, cel.Column) = cel

Else: GoTo 2

End If

2 Next

Else: GoTo 1

End If

1 Next

Set MySh = Nothing

End Sub

[رجب جاويش]

بعد إذن الأخ الفاضل / بن عليه

قمت بتعديل شرط درجة المادة فى المعادلة الى ( اكبرمن أو يساوى ) النهاية الصغري اتركه فارغ

=IF($D8="";"";IF(AND(Formule>=E$7;Formule<>"غ");"";Formule))

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

اسماء ودرجات الدور الثانى فقط لاغير2.rar

[فضل حسين]

الف شكر

للمايسترو

والاخ الفاضل / رحب

جزاكم الله كل خير وهو المطلوب بالضبط

هاتوحشونى الى ان نتقابل فى مشاركة اخرى قريبا ان شاء الله

سلام