عند تشغيل الكود يتم تظليل كافة الخلايا للطلاب ا.....  اريد فقط التي تم رفعها اي التي درجاتها باللون الاحمر
 

 جزاك الله خيرا استاذ ياسر .... جعله الله بميزان حسناتك...

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

 شاكر فضل حضرتك استاذ ياسر،، جزاك الله كل خير

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

 جزاك الله خيرا استاذ سليم

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

اشكر حضرتك على سعة صدرك الواسعه

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

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

هل يمكن الترحيل دون التقديرات  اي الترحيل فقط ( الجلوس- الاسم - - النتيجه)
 
 لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

 

 الحمد لله تم التوصل للحل النهائي بفضل الله ثم مجهود الأخ العزيز الأستاذ سليم... جزاه الله كل خير

وهذا هو الكود بشكله النهائي ....
Option Explicit

Dim Res, N1, N2

Dim st_BOOL, st_good, st_Vgood, st_Exc$

Dim SH As Worksheet, i%, lr%

'+++++++++++++++++++++++++++++++++

Sub Get_Resulte()

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

End With



Set SH = Sheets("DATA")



lr = SH.Cells(Rows.count, "C").End(3).Row

 For i = 5 To lr Step 4

     If SH.Cells(i, "BK") = vbNullString _

       Or SH.Cells(i, "AX") = vbNullString Then

       SH.Cells(i, "BL") = _

       IIf(SH.Cells(i + 3, "AX") = _

       vbNullString, "----", SH.Cells(i + 3, "AX"))

       GoTo Next_i

    End If

    Call Verifay(SH.Cells(i, "AX"), SH.Cells(i, "BK"))

    SH.Cells(i, "BL") = Res

 

Next_i:

     

 Next



With Application

  .ScreenUpdating = True

  .Calculation = xlCalculationAutomatic

End With



End Sub

'+++++++++++++++++++++++++++++++

Sub Verifay(rang1 As Range, rang2 As Range)

st_BOOL = "مقبول"

st_good = "جيد"

st_Vgood = "جيد جدا"

st_Exc = "ممتاز"



N1 = rang1: N2 = rang2

Select Case True

 Case N1 >= 600 And N1 <= 799 And N2 >= 1 And N2 <= 13

     Res = st_BOOL

  Case N1 >= 800 And N1 <= 924 And N2 >= 1 And N2 <= 13

     Res = st_good

 Case N1 >= 925 And N1 <= 1049 And N2 >= 1 And N2 <= 13

    Res = st_Vgood

 Case N1 >= 1050 And N1 <= 1062 And N2 >= 1 And N2 <= 13

    Res = st_Exc

 Case Else

    Res = SH.Range("AX8")

End Select



End Sub

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

والتمس العذر لي ..وجزاك الله خيرا على المساعده ...وكفايه اهتمام حضرتك بالرد علي...

لكن المعادله قمت بوضعها في بداية الموضوع ..وكنت اريد عمل كود لها...

وحببت ان اخد الموضوع خطوه خطوه لكي اصل في النهايه للمطلوب..

والكود سليم وكويس جداااااااااااااااااااا

لكن لا يتم كتابة  (----) هذا ما كنت اقصده ......بس

 شاكر حضرتك استاذ ياسر جدااا جزاك الله خيرا
 

- - - كلام حضرتك مضبوط استاذ سليم . . . اريد الخليه AX..لكن لا يتم كتابتها بالملف..

ثانيا :وجدت ان برغم تقدير الطالب المرتفع يقوم الكود بتنزيل درجته.
 
 
 

 

 الكود شغال تمام حضرتك..... لكن لا يعطي هذه القيمه "----"

بل يتم ترك الخليه فارغه ؟؟؟؟؟ هل من حل لها؟؟؟ اكرمك الله
 

 نعم اخي سليم . .. .  الماكرو توقف لذلك

وهو انه وجد احد الخليتين فارغه...

-----.هل هناك امكانيه اذا كانت خلية المجموع فارغه  . . . . يعطي (----) وهو قيمة الخلية(AX)
 

 

 حضرتك بعد تجريب الماكرو بتزويد عدد الطلاب وجدت انه يقوم بحساب ثلاثة طلاب فقط.... ؟؟؟؟

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