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

[مصطفى حسين]

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

اساتذتي الافاضل ...

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

 

داعيا الله التوفيق للجميع

 

 
 
 
 

Private Sub CommandButton1_Click()
Dim Lr As Long
 With Sheets("ارشيف")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1
    ("Cells(Lr, "B").Value = Me.Controls("B1")
    ("Cells(Lr, "C").Value = Me.Controls("C1")
    ("Cells(Lr, "D").Value = Me.Controls("D1")
    ("Cells(Lr, "E").Value = Me.Controls("E1")
    ("Cells(Lr, "F").Value = Me.Controls("F1")
    
     MsgBox ("تم النسخ للارشيف")
End With
End Sub 
 

[أبو حنــــين]

جرب هذا التعديل على افتراض ان القيمة المعنية بعدم التكرار موجودة في العمود B

Private Sub CommandButton1_Click()

Dim Lr As Long
 With Sheets("ورقة2")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1
If Application.WorksheetFunction.CountIf(.Range("B2:B" & Lr), B1) = 1 Then
MsgBox "هذه القيمة مكررة", vbExclamation, "خطأ"
Exit Sub
End If
    .Cells(Lr, "B") = Me.Controls("B1").Value
    .Cells(Lr, "C") = Me.Controls("C1").Value
    .Cells(Lr, "D") = Me.Controls("D1").Value
    .Cells(Lr, "C") = Me.Controls("E1").Value
    .Cells(Lr, "D") = Me.Controls("F1").Value
     MsgBox ("تم النسخ للارشيف")
End With

End Sub

[أبو حنــــين]

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

With Sheets("ارشيف")

[مصطفى حسين]

أدعوا من الله أن يسدد خطاك وأن لايحرمنا منكم جميعا 

 

 

أشكرك أستاذي الفاضل / أبوحنين

فالكود يعمل 100 %

 

ولدي إستفسار عسى ان لا أكون ثقيلا عليكم بطلباتي 

الاستفسار هو : هل بإستطاعتي ان اعمل قيمتين إفتراضيتين لعدم التكرار ؟ مثلا العمود B والعمود C

 

 

وأدعو الله أن يوفقنا أجمعين 

[أبو حنــــين]

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

Private Sub CommandButton1_Click()

Dim Lr As Long, Val1, Val2
 With Sheets("ارشيف")
    Lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1
Val1 = Application.WorksheetFunction.CountIf(.Range("B2:B" & Lr), B1)
Val2 = Application.WorksheetFunction.CountIf(.Range("C2:C" & Lr), C1)
If Val1 = 1 Or Val2 = 1 Then
MsgBox "هذه القيمة مكررة", vbExclamation, "خطأ"
Exit Sub
End If
    .Cells(Lr, "B") = Me.Controls("B1").Value
    .Cells(Lr, "C") = Me.Controls("C1").Value
    .Cells(Lr, "D") = Me.Controls("D1").Value
    .Cells(Lr, "C") = Me.Controls("E1").Value
    .Cells(Lr, "D") = Me.Controls("F1").Value
     MsgBox ("تم النسخ للارشيف")
End With

End Sub

[مصطفى حسين]

أشكرك استاذي الفاضل / ابوحنين 

لقد أتممت الموضوع في أدق التفاصيل وفي أسرع وقت 

 

فأنا عاجز عن شكري لسماحتكم 

 

 

فأطلب الله أن يوفقك ويوفقنا جميعا لما يحبه ويرضاه.

 

 

[أبو حنــــين]

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