اذهب الي المحتوي
أوفيسنا

كيف اجعل فورم ترحيل البيانات يمنع تكرير البيانات في الشيت


إذهب إلى أفضل إجابة Solved by عبدالله المجرب,

الردود الموصى بها

السلام عليكم اخواني واساتذتي الاعزاء في هذا الصرح الشامخ :

قمت بتصميم فورم ترحيل البيانات الى الشيت كما هو واضح في الملف المرفق ولكن كيف امنع تكرار البيانات في كل الصفوف بحيث عندما تتطابق كل المعلومات تظهر رسالة تكرار المعلومات .ولكم مني وافر الاحترام والتقدير.

مساعدة1.rar

رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليكم 

إستبدل كود زر الحفظ في البورم بهذا

Private Sub CommandButton1_Click()
Dim iRow As Long, Cl As Range, Abu_Ahmed As Boolean
Dim ws As Worksheet
T = [B10000].End(xlUp).Row
Set ws = Worksheets("ورقة1")
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
  
'==================================================================================
For Each Cl In Range("B2:B" & [B10000].End(xlUp).Row)
If Cl = Me.TextBox2.Value Then
If Cl.Offset(0, 1) = Me.TextBox3.Value And Cl.Offset(0, 2) = Me.TextBox4.Value And _
Cl.Offset(0, 3) = Val(Me.TextBox5.Value) Then Abu_Ahmed = True: GoTo 1
End If
Next
1 If Abu_Ahmed Then
MsgBox "البيانات موجودة مسبقاً": GoTo 2
Else
 ws.Cells(iRow, 2).Value = Me.TextBox2.Value
  ws.Cells(iRow, 3).Value = Me.TextBox3.Value
  ws.Cells(iRow, 4).Value = Me.TextBox4.Value
  ws.Cells(iRow, 5).Value = Me.TextBox5.Value
  End If
'=====================================================================================
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox2.SetFocus
2 End Sub
رابط هذا التعليق
شارك

 

السلام عليكم 

إستبدل كود زر الحفظ في البورم بهذا

Private Sub CommandButton1_Click()
Dim iRow As Long, Cl As Range, Abu_Ahmed As Boolean
Dim ws As Worksheet
T = [B10000].End(xlUp).Row
Set ws = Worksheets("ورقة1")
iRow = ws.Cells(Rows.Count, 2) _
  .End(xlUp).Offset(1, 0).Row
  
'==================================================================================
For Each Cl In Range("B2:B" & [B10000].End(xlUp).Row)
If Cl = Me.TextBox2.Value Then
If Cl.Offset(0, 1) = Me.TextBox3.Value And Cl.Offset(0, 2) = Me.TextBox4.Value And _
Cl.Offset(0, 3) = Val(Me.TextBox5.Value) Then Abu_Ahmed = True: GoTo 1
End If
Next
1 If Abu_Ahmed Then
MsgBox "البيانات موجودة مسبقاً": GoTo 2
Else
 ws.Cells(iRow, 2).Value = Me.TextBox2.Value
  ws.Cells(iRow, 3).Value = Me.TextBox3.Value
  ws.Cells(iRow, 4).Value = Me.TextBox4.Value
  ws.Cells(iRow, 5).Value = Me.TextBox5.Value
  End If
'=====================================================================================
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox2.SetFocus
2 End Sub

شكرا ياأخي واستاذي الغالي هذا ماكنت ابحث عنه وان شاء الله يكون في ميزان حسناتك والله يبارك فيك وتقبل مني وافر التقدير والاحترام.

رابط هذا التعليق
شارك

  • 3 months later...

السلام عليكم

 

هل يمكن شرح هذا الجزء ولا سيما الجزء الاول حتى كلمة Else

For Each Cl In Range("B2:B" & [B10000].End(xlUp).Row)
If Cl = Me.TextBox2.Value Then
If Cl.Offset(0, 1) = Me.TextBox3.Value And Cl.Offset(0, 2) = Me.TextBox4.Value And _
Cl.Offset(0, 3) = Val(Me.TextBox5.Value) Then Abu_Ahmed = True: GoTo 1
End If
Next
1 If Abu_Ahmed Then
MsgBox "البيانات موجودة مسبقاً": GoTo 2
Else
 ws.Cells(iRow, 2).Value = Me.TextBox2.Value
  ws.Cells(iRow, 3).Value = Me.TextBox3.Value
  ws.Cells(iRow, 4).Value = Me.TextBox4.Value
  ws.Cells(iRow, 5).Value = Me.TextBox5.Value
  End If

وشكرا

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information