عدم تكرار بيانات موجوده سابقا

[ابو حمادة]

السلام عليكم ورحمة الله تعالي وبركاته     .........  الاخوة الافاضل اساتذتي الكرام

ارجو المساعده في الاتي

عدم تكرار البيانات.rar

مرفق ملف  للتوضيح اكثر ......... ولكم منى جزيل الشكر 

 

 

[الشهابي]

أخي العزيز / أبو حمادة

ضع هذا الكود في حدث الفورم 

Private Sub TextBox1_Change()
Set ws = Worksheets("ورقة1")
Lr = ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
For Each cl In Range("b5:b" & Lr)
If Me.TextBox1.Text = cl.Text Then
MsgBox ("هذا الاسم موجود مسبقا قم باختياراسم آخر")
End If
Next cl
End Sub

 

[ابو حمادة]

شكرا ليك استاذي الغالي بس لو ممكن تعدل الكود بحيث يكون مع مفتاح الاضافه وليس في حدث التكست بوكس

دا الكود حول اركبه على بعضه واشتغل بس بتظهر الرساله  تفيد ان الاسم موجود سابقا وبيتم الاضافه ايضا

Private Sub CommandButton1_Click()
Dim Lr As Integer, ws As Worksheet
Set ws = Worksheets("æÑÞÉ1")
      Lr = ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
For Each cl In Range("b5:b" & Lr)
If Me.TextBox1.Text = cl.Text Then
MsgBox ("åÐÇ ÇáÇÓã ãæÌæÏ ãÓÈÞÇ Þã ÈÇÎÊíÇÑÇÓã ÂÎÑ
End If
Next cl
ws.Cells(Lr, 2).Value = Me.TextBox1.Text 
ws.Cells(Lr, 3).Value = Me.TextBox2.Text
ws.Cells(Lr, 4).Value = Me.TextBox3.Text
End Sub

تم تعديل يناير 23, 2017 بواسطه ابو حمادة

[الشهابي]

أخي العزيز / أبو حمادة

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

Private Sub CommandButton1_Click()
Dim Lr As Integer, ws As Worksheet, answer As Integer
Set ws = Worksheets("ورقة1")
      Lr = ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
For Each cl In Range("b5:b" & Lr)
   If Me.TextBox1.Text = cl.Text Then
   answer = MsgBox("هذا الاسم موجود مسبقا هل تريد الإضافة أو أضغط لا وقم باختيار اسم آخر ", vbYesNo + vbQuestion, "Empty Sheet")
      If answer = vbYes Then
         ws.Cells(Lr, 2).Value = Me.TextBox1.Text '"الاسم"'
         ws.Cells(Lr, 3).Value = Me.TextBox2.Text '"الوظيفه"'
         ws.Cells(Lr, 4).Value = Me.TextBox3.Text '"رقم الموبيل"'
       Else
       End If
   End If
Next cl
End Sub