تقديرات الطلاب؟

[عبدالعزيز محمد]

السلام عليكم اخواني في المنتدى الغالي

في المرفق بطاقة تقدير درجات طلاب 

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

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

Aziz.rar

[احمد بدره]

تفضل المطلوب

 

Aziz.rar

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

بالاذن من الاستاذأحمد 

هذا الماكرو ربما يفي بالمطلوب

Option Explicit
Sub evaluate_result()
Dim my_arr()
Dim i As Byte
Dim k As Byte: k = 0
Dim st$: st = " يحتاح للعناية في: "
Dim Mot
Dim resulte$
 For i = 5 To 9
  If Range("d" & i) < Range("c" & i) / 2 Then
   ReDim Preserve my_arr(0 To k)
    my_arr(k) = Range("A" & i).Value
    k = k + 1
   End If
   Next
If k > 0 Then
       Mot = Join(my_arr, ",")
       Range("H4") = st & Chr(10) & Mot
       Exit Sub
Else
    Select Case Range("d11") / Range("c11") * 100
      Case Is >= 0.85: resulte = "ممتاز"
      Case Is >= 0.75: resulte = "جيد جدا"
      Case Is >= 0.65: resulte = "جيد"
      Case Is >= 0.5: resulte = "متوسط"
      Case Else: resulte = "راسب"
    End Select
End If
      Range("H4") = resulte
End Sub

الملف مرفق

Aziz_salim.xlsm

[عبدالعزيز محمد]

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

بارك لله فيكم على الرد 

أما بالنسبة لمشاركة اخينا  احمد حبذا لو كانت التقديرات في خلية واحدة وهي ملونة باللون الاصفر -خلية كبيرة الحجم عمل لها دمج ويمكن ان تكون اصغر من ذلك .

وأما بالنسبة لمشاركة اخينا سليم اي الكود فهو ممتاز لو كانت صحيفة واحدة ولكن سوف تكون عدة صحائف حسب عدد طلاب الصف 20 أو أكثر فهي لا تحقق المطلوب منها في عدة صحائف

نأمل أن يكون المطلوب واضحا 

وشكرا على الرد وهو ما تعودناه من الاساتذة التي تعلمنا منهم الكثير 

 

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

هذا الماكرو يقوم بالمطلوب في كل الأوراق (قم بتنفيذ الماكرو الاول)

Option Explicit

Sub One_for_All_macro()
Dim Sh_num%
 For Sh_num = 1 To Sheets.Count
  Sheets(Sh_num).Activate
  evaluate_result
Next

End Sub
'=============================
Sub evaluate_result()
Dim my_arr()
Dim i As Byte
Dim k As Byte: k = 0
Dim st$: st = " يحتاح للعناية في: "
Dim Mot
Dim resulte$
 For i = 5 To 9
  If Range("d" & i) < Range("c" & i) / 2 Then
   ReDim Preserve my_arr(0 To k)
    my_arr(k) = Range("A" & i).Value
    k = k + 1
   End If
   Next
If k > 0 Then
       Mot = Join(my_arr, ",")
       Range("H4") = st & Chr(10) & Mot
       Exit Sub
Else
    Select Case Range("d11") / Range("c11") * 100
      Case Is >= 0.85: resulte = "ممتاز"
      Case Is >= 0.75: resulte = "جيد جدا"
      Case Is >= 0.65: resulte = "جيد"
      Case Is >= 0.5: resulte = "متوسط"
      Case Else: resulte = "راسب"
    End Select
End If
      Range("H4") = resulte
     
End Sub

 

[عبدالعزيز محمد]

السلام عليكم اخينا سليم دائما في الموعد جزاك الله خيرا 

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

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

دائما نتعلم منكم مزيدا من الابداع 

Aziz.rar

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

الطريقة التي تعتمدها صعبة لتنفيد ماكرو (مع أنها غير مستحيلة) و تتطلب ايضاً تحديد الـــ Print Areas 

لذلك قم بنسخ الجدول من  A1 الى J21  الى عدة شيتات   (كل شيت باسم طالب ) ,و تحدد فيها Print Areas من  A1 الى J21  

و نفذ الماكرو

[عبدالعزيز محمد]

السلام عليكم اخينا سليم دائما في الموعد جزاك الله خيرا 

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

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

دائما نتعلم منكم مزيدا من الابداع 

السلام عليكم 

جزاك الله خيرا اخي سليم وكل اعضاء المنتدى الغالي

كانت عندي معادلة تقوم بهذا العمل ولكنني نسيتها وهي تصلح لهذا الامر 

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

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