طلب تعديل رسالة الخطأ ودمج اللائحة المنسدلة

[hicham2610]

السلام عليكم

الاخوة الكرام

هل من كود vba او معادلة أو برمجة للقيام بالتالي:

حذف الفراغات بين الأسماء في الجداول الأربعة الموجودة جهة اليمين

يجب منع وضع x في أكثر من خلية واحدة من الأعمدة 0،1،2،3 لكل موضوع

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

1.xlsm

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

الرد على السؤال الاول

يجب منع وضع x في أكثر من خلية واحدة من الأعمدة 0،1،2،3 لكل موضوع

قمت بوضع ملف نموذج صغير (صفحة salim) يستجيب لهذا التساؤل 

ممكن نسخ الكود والتعديل عليه بما يناسب الصفحة والنطاق التي يجب العمل عليها

Option Explicit
Private Sub Worksheet_Activate()
data_validation
End Sub
Rem"""""""""""""""""""""
Rem =====>Created By Salim Hasbaya on 4/7/2019
    ' How to prevent the User from writing Duplicate
    ' In Given Range
Sub data_validation()
Dim k%
Dim t
 With Sheets("Salim")
 Dim single_RG As Range
 Dim LR%: LR = .Cells(Rows.Count, 2).End(3).Row - 5
 Dim my_rg As Range
 Dim sub_rg As Range
 
  Set my_rg = .Range("b9:q" & LR)
    For k = 2 To 17 Step 4
     Set single_RG = .Range(Cells(9, k), Cells(LR, k + 3))
      Select Case single_RG.Cells(1, 1).Address(0, 0)
        Case "B9": Set sub_rg = Range("b9:E" & LR)
        Case "F9": Set sub_rg = Range("E9:I" & LR)
        Case "J9": Set sub_rg = Range("J9:M" & LR)
        Case "N9": Set sub_rg = Range("N9:Q" & LR)
      End Select
      '======================
      Select Case single_RG.Address(0, 0)
       '+++++++++++++++++++++++++++++
       Case "B9:E" & LR
        With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($B9:$E9" & "," & "B" & 9 & ")<=1"
       End With
       '++++++++++++++++++++++++++++++
           Case "F9:I" & LR
       With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($F9:$I9" & "," & "F" & 9 & ")<=1"
       End With
                  
      '+++++++++++++++++++++++++++++
       Case "J9:M" & LR
        With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
          Formula1:="=COUNTIF($J9:$M9" & "," & "J" & 9 & ")<=1"
       End With
                 
      '+++++++++++++++++++++++++++++
      
       Case "N9:Q" & LR
     With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($N9:$Q9" & "," & "N" & 9 & ")<=1"
       End With
    End Select
      '==========================
    Next
    Set my_rg = Nothing: Set sub_rg = Nothing
    Set single_RG = Nothing
  End With
End Sub

بالنسبة للسؤال الثاني لم استطع فهم ماتريد (يرجى حذف عمليات دمج الخلايا)

الملف النموذج مرفق

 

 

Salim_Data_val.xlsm

[hicham2610]

جزاك الله خيرا وأحسن إليك

[hicham2610]

السلام عليكم

أدخلت كودا منحه إلي الأخ الفاضل سليم حاصبيا ، جزاه الله خيرا،هذا الكود يمنع كتابة أكثر من علامة في الموضوع الواحد، في المجال:B9:Q45 ورقة"تراكيب"، ومن وضع أكثر من علامة تخرج رسالة الحطأ هذه الرسالة هي الإفتراضية في إكسيل

1- هل من تدخل لتغييرها برسالة:"أخطأت في الكتابة، لاتدخل أكثر من علامة"؟

2-بإدخالي لهذا الكود ، حذف لي لائحة منسدلة بها:x و فراغ وهذه اللائحة موجودة ب:DD1:DD2،هذه اللائحة كانت مبرمجة في في المجال:B9:Q45 ورقة"تراكيب"؟ وكانت رسالة الخطأ "اكتب علامة أو اتركها فارغة، أو اختر من اللائحة"

هل من تدخل لإرجاع هذه اللائحة المنسدلة لتعمل مع هذا الكود؟

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

ملف.xlsm

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

في الخلية الواحدة تستطيع ان تضع   data validation واحدة

اختر بين ان يكون عدد الــ  X مرة واحدة او قائمة منسدلة تحتوي على X فقط

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

 

 

Option Explicit
Private Sub Worksheet_Activate()
data_validation
End Sub
Rem"""""""""""""""""""""
Rem =====>Created By Salim Hasbaya on 4/7/2019
    ' How to prevent the User from writing Duplicate
    ' In Given Range
Sub data_validation()
 Dim k%
Dim t
 With Sheets("تراكيب")
 Dim single_RG As Range
 Dim LR%: LR = .Cells(Rows.Count, 2).End(3).Row - 5
 Dim my_rg As Range
  Dim sub_rg As Range
 
  Set my_rg = .Range("b9:q" & LR)
    For k = 2 To 17 Step 4
     Set single_RG = .Range(Cells(9, k), Cells(LR, k + 3))
      Select Case single_RG.Cells(1, 1).Address(0, 0)
        Case "B9": Set sub_rg = Range("B9:E" & LR)
        Case "F9": Set sub_rg = Range("F9:I" & LR)
        Case "J9": Set sub_rg = Range("J9:M" & LR)
        Case "N9": Set sub_rg = Range("N9:Q" & LR)
      End Select
      '======================
      Select Case single_RG.Address(0, 0)
       '+++++++++++++++++++++++++++++
       Case "B9:E" & LR
        With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($B9:$E9" & "," & "B" & 9 & ")<=1"
         .ErrorTitle = "انتباه"
         .ErrorMessage = "ا يمكن ادخال X الا مرة واحدة "
                
       End With
       '++++++++++++++++++++++++++++++
           Case "F9:I" & LR
       With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($F9:$I9" & "," & "F" & 9 & ")<=1"
        .ErrorTitle = "انتباه"
         .ErrorMessage = "لا يمكن ادخال X الا مرة واحدة "
       End With
      '+++++++++++++++++++++++++++++
       Case "J9:M" & LR
        With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($J9:$M9" & "," & "J" & 9 & ")<=1"
        .ErrorTitle = "انتباه"
         .ErrorMessage = "ا يمكن ادخال X الا مرة واحدة "

       End With
                 
      '+++++++++++++++++++++++++++++
      
       Case "N9:Q" & LR
     With single_RG.Validation
        .Delete
        .Add Type:=xlValidateCustom, _
         Formula1:="=COUNTIF($N9:$Q9" & "," & "N" & 9 & ")<=1"
        .ErrorTitle = "انتباه"
         .ErrorMessage = "ا يمكن ادخال X الا مرة واحدة "

       End With
    End Select
      '==========================
    Next
    Set my_rg = Nothing: Set sub_rg = Nothing
    Set single_RG = Nothing
  End With
End Sub