هل من حل ماكرو أو تنسي شرطي

[المسلم العربي]

أهلأ إخواني و أشكركم على ردودكم 

هل من حل حل حتى تظهر الرسالة الآتية باللون الأحمر 
stop  هناك قسم مكتوب بشكل غير صحيح تأكد
يعني هناك مجموعة من التلاميذ بأقسام معينة محددة مسبقاً و تساعدك على حساب معدلات في ورقة أخرى 
و لذلك إذا أخطأ الأستاذ في إدخال قسم أي تلميذ معين أو أكثر من تلميذ تظهر الرسالة كما هو موضح في الصورة 
هل من حل الصورة توضح :
 

Demand Answer .rar

تم تعديل يوليو 6, 2017 بواسطه المسلم العربي

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

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

باستعمال خاصية "التحق من الصحة" Validation (تجدها في قائمة DATA "بيانات") تم إدراج قائمة منسدلة للأقسام مع رسالة خطأ في حالة عدم توافق كتابة اسم القسم مع عناصر القائمة المنسدلة للأقسام (ومن مساوئ هذه الطريقة أنه إذا تم نسخ ولصق أي شيء في خلايا هذه القائمة فإن الإكسيل يقبلها ولا يُظهر رسالة الخطأ)... والله أعلم

بن علية حاجي

Demand Answer .rar

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

بعد اذن اخي بن علية

جرب هذا الشيئ

 

Demand Answer_Salim.rar

[المسلم العربي]

شكرا أخي بن علية و أخي سليم على الردود 
أخوتي لكن المشكل لدي عدة أقسام معنية 
 

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

السلام عليكم

قمت بكتابة الأقسام المعنية تحت بعض من الخلية AF4 إلى الخلية AF27 واستوحيت الفكرة من ملف أخي العزيز سليم لتقديم هذا الحل... فقط يجب أن يتم إدراج الأقسام بالتسلسل (أي يجب أن لا نترك خلايا فارغة في عمود القسم بين طالب وآخر)...

بن علية حاجي 

Demand Answer_hben.rar

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

تم التعديل على المعادلة

 

 

 

Demand Answer_Salim_1.rar

[المسلم العربي]

أخي سليم و لما الخلايا فارغة يجب أن لا تظهر الرسالة 

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

4 دقائق مضت, المسلم العربي said:

أخي سليم و لما الخلايا فارغة يجب أن لا تظهر الرسالة 

و هكذا هو الامر (فقط اذا تم تسجيل قسم خاطئ تظهر الرسالة)

اظر الى الصفحة Salim من هذا الملف

Demand Answer_Salim_2.rar

[المسلم العربي]

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

تم تعديل يوليو 6, 2017 بواسطه المسلم العربي

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

9 دقائق مضت, المسلم العربي said:

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

تم معاجة الامر

انظر الى الصفحة Salim من هذا الملف

Demand Answer_Salim_3.rar

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

السلام عليكم

الحل في هذا الرد...

منذ ساعه, بن علية حاجي said:

السلام عليكم

قمت بكتابة الأقسام المعنية تحت بعض من الخلية AF4 إلى الخلية AF27 واستوحيت الفكرة من ملف أخي العزيز سليم لتقديم هذا الحل... فقط يجب أن يتم إدراج الأقسام بالتسلسل (أي يجب أن لا نترك خلايا فارغة في عمود القسم بين طالب وآخر)...

بن علية حاجي 

Demand Answer_hben.rar

بن علية حاجي

[المسلم العربي]

أخر سؤال و هل يمكن عمل هذا العمل على شكل ماكرو Macro تلقائي مرن للتعديل لأن المعادلات معقدة وصعبة الفهم و شكرا أخوتي الكرام

تم تعديل يوليو 6, 2017 بواسطه المسلم العربي

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

7 ساعات مضت, المسلم العربي said:

أخر سؤال و هل يمكن عمل هذا العمل على شكل ماكرو Macro تلقائي مرن للتعديل لأن المعادلات معقدة وصعبة الفهم و شكرا أخوتي الكرام

تفضل الملف مع الكود

انظر الى الصفحة Salim _with_Macro

Demand Answer_Salim_4.rar

[المسلم العربي]

أهلا أخي سليم و شكرا لك لما جرب الملف أعطاني هذا الخطأ و والله أنا ممتن لك و لردودك الجميلة لك كل الشكر و الاعتزاز

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

3 ساعات مضت, المسلم العربي said:

أهلا أخي سليم و شكرا لك لما جرب الملف أعطاني هذا الخطأ و والله أنا ممتن لك و لردودك الجميلة لك كل الشكر و الاعتزاز

هذا لان الكود يحتوي على اللغة عربية في بعض سطوره

انسخ هذين الكودين الى الملف من جديد

Option Explicit

Sub give_Alert()
Dim My_Sh As Worksheet
Dim R_G, Cel As Range
Dim y As Boolean
Dim r As Integer
Application.EnableEvents = False
Set My_Sh = Sheets("Salim _with_Macro")
Set R_G = My_Sh.Range("d4:d53")
R_G.Interior.ColorIndex = 0
For Each Cel In R_G

If Cel <> "" Then
y = Evaluate("=OR(""" & Cel & "" & """=AF4:AH11)")
 If Not y Then
 If r = 0 Then
Cel.Interior.ColorIndex = 3
MsgBox "خطأ في القسم التابع لــــــ : " & Cel.Offset(, -2) & _
Chr(10) & "تم تلوين الاخطاء بالأحمر" _
, vbMsgBoxRight, "سليم يقول لك"
End If
r = r + 1
Cel.Interior.ColorIndex = 3
  End If
End If
  Next
1:
Application.EnableEvents = True

End Sub
'=========================================
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim my_rg As Range
Set my_rg = Range("d4:d53")
If Not Intersect(Target, my_rg) Is Nothing Then
give_Alert
Target.Select
End If
Application.ScreenUpdating = True
End Sub