المطلوب هو أن يكون الحد الأقصى للكتابة 50 مرة

[EL_Kashef]

 

المطلوب هو أن يكون الحد الأقصى لكتابة الرقم 2 فى النطاق المحدد هو 50 مرة لا يزيد عن ذلك وطبعا ممكن أن يقل

ولو أمكن تحديد الارقام الممكن كتابتها

يعنى نفس الكلام بالنسبة للارقام من 1 الى 10 كل رقم لا يزيد كتابته عن 50 مرة بفرض ان المدى 500 خلية

واعطاء رسالة تنبيه عند زيادة العدد المكتوب عن 50 مرة بأنه تخطى الحد المسموح به

 

مرفق مثال

 

واذا احتجتم الملف الأصلى موجود انا ممكن ارفعه

Book1.rar

[ياسر خليل أبو البراء]

السلام عليكم

جرب الكود التالي في حدث ورقة العمل عله يفي بالغرض

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 5 And Target.Column = 4 Then
        Dim lr As Long, x As Long
        lr = Cells(Rows.Count, Target.Column).End(xlUp).Row
        x = Application.WorksheetFunction.CountIf(Range("D6:D" & lr), Target.Value)
        If x > 50 Then MsgBox "The Number " & Target.Value & " Exceeds 50", vbExclamation
    End If
End Sub

 

[EL_Kashef]

للأسف لم يفلح معى

ربما الخطأ من عندى

سأرفع لكم الملف كامل

والمطلوب فضلا لا أمرا

فى صفحة بيانات الطلاب

فى خانة الفصل

المطلوب عدم تكرار رقم الفصل 1 لأكثر من 50 مرة

لأن الحد الأقصى لطلاب الفصل هو 50

 وكذلك بالنسبة للفصل 2

وحتى الفصل 10لأن العدد الأقصى لطلاب الفرقة 500 طالب

بفرض أنه سيتم توزيعهم على 10 فصول

فبكون الحد الأقصى لكل فصل 50 طالب

أرجو أن تكون قد وصلت الفكرة

إليكم الملف كامل فى المرفقات

برنامج قوائم الفصول.rar

[ياسر خليل أبو البراء]

هل المطلوب كود يوضع في موديول عادي أم في حدث ورقة العمل؟

والمدخلات ستكون فقط أرقام من 1 إلى 10 ...ولا يجوز لأية مدخلات أخرى أن توجد ..أم ماذا؟

[EL_Kashef]

 

المطلوب حدث فى ورقة العمل وليس مديول بزر

والمدخلات ستكون فقط أرقام من 1 إلى 10 ...ولا يجوز لأية مدخلات أخرى أن توجد

 

[ياسر خليل أبو البراء]

جرب التعديل التالي ...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 5 And Target.Column = 4 Then
        Dim lr As Long, x As Long, y As Variant
        y = Target.Value
        lr = Cells(Rows.Count, Target.Column).End(xlUp).Row
        x = Application.WorksheetFunction.CountIf(Range("D6:D" & lr), y)
        If y < 1 Or y > 10 Or Not IsNumeric(y) Then MsgBox "Wrong Entry", vbExclamation: Exit Sub
        If x > 50 Or y < 1 Or y > 10 Then MsgBox "The Number " & Target.Value & " Exceeds 50", vbExclamation
    End If
End Sub

 

[EL_Kashef]

يعطى هذا الخطأ عند ادخال اى رقم

 

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

حرب هذا الملف

 

Book1 Salim.rar

[EL_Kashef]

عمل رائع سيد سليم

لكن كيف أقوم بتطبيق هذا على ملف قوائم الفصول

وقد قمت برفع الملف فى مشاركة سابقة فى هذا الموضوع

وأرجو الطريقة لإضافتها إلى باقى الملفات عندى الخاصة بقوائم الفصول

[ياسر خليل أبو البراء]

استبدل كلمة CountLarge بكلمة Count ..حيث يبدو أن إصدار الأوفيس لديك قديم

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

3 ساعات مضت, EL_Kashef said:

عمل رائع سيد سليم

لكن كيف أقوم بتطبيق هذا على ملف قوائم الفصول

وقد قمت برفع الملف فى مشاركة سابقة فى هذا الموضوع

وأرجو الطريقة لإضافتها إلى باقى الملفات عندى الخاصة بقوائم الفصول

1-اختر اي خلية من العامود D 

2-اضغط Alt+D+L تظهر لك نافذة والمعادلة المطلوبة من الخلية D6 لغاية الخلية D506

 

تم تعديل يوليو 10, 2017 بواسطه سليم حاصبيا

[EL_Kashef]

الشكر موصول لجميع الأعضاء

تم تعديل كود السيد ياسر خليل ويعمل بكفاءة على الملف المرفق

لكن ينقص شئ واحد

الملف يعطى رسالة التنبيه لكنه يقبل الرقم

أريده لا يقبل الرقم المكتوب الأكثر من 50 مرة

مرفق الملف

برنامج قوائم الفصول.rar

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

جرب هذا التعديل

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Target.Cells.CountLarge > 1 Then GoTo 1
    If Target.Row > 5 And Target.Column = 4 Then
        Dim lr As Long, x As Long, y As Variant
        y = Target.Value
        lr = Cells(Rows.Count, Target.Column).End(xlUp).Row
        x = Application.WorksheetFunction.CountIf(Range("D6:D" & lr), y)
        If y < 1 Or y > 10 Or Not IsNumeric(y) Then MsgBox "Wrong Entry", vbExclamation: Exit Sub
        If x > 50 Or y < 1 Or y > 10 Then _
        MsgBox "The Number " & Target.Value & " Exceeds 50" & Chr(10) & _
        "this number will be deleted", vbExclamation: Target = ""
    End If
1:
    Application.EnableEvents = True
End Sub

 

[EL_Kashef]

للأسف لم يفلح معى الكود

ما زال يقبل الأرقام

[ياسر خليل أبو البراء]

لا أدري ما المشكلة بالضبط لديك فالأمر غير واضخ تماماً .. عموماً حسب ما فهمت جرب الكود التالي عله يفي بالغرض

(ولا داعي لاستخدام التحقق من الصحة في هذه الحالة)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row > 16 And Target.Column = 7 Then
        Dim lr As Long, x As Long, y As Variant
        y = Target.Value
        lr = Cells(Rows.Count, Target.Column).End(xlUp).Row
        Application.EnableEvents = False
        x = Application.WorksheetFunction.CountIf(Range("G17:G" & lr), y)
        If y < 1 Or y > 10 Or Not IsNumeric(y) Then MsgBox "Wrong Entry", vbExclamation: Target.Value = "": GoTo Skipper
        If x > 50 Or y < 1 Or y > 10 Then MsgBox "انتبه . الرقم " & Target.Value & " تجاوز العدد 50", vbExclamation: Target.Value = ""
    End If
Skipper:
    Application.EnableEvents = True
End Sub