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

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

قام بنشر

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

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

مساعدة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