اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

وأما بالنسبة لمشاركة اخينا سليم اي الكود فهو ممتاز لو كانت صحيفة واحدة ولكن سوف تكون عدة صحائف حسب عدد طلاب الصف 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  

و نفذ الماكرو

رابط هذا التعليق
شارك

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

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

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

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

السلام عليكم 

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

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

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

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information