Ashraf Ehab

تم حل مشكلة مسح البيانات بنجاح وتبقي المشكلة الاولي وحل مشكلة المسح كانت كالاتي Dim qp As Integer Dim rp As Integer Dim wp As Integer Dim ep As Integer qp = purchasesSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1 wp = ItemsSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ep = suppliersSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 rp = Me.ListBox1.ListCount Dim t As Range Dim firsttAddress, ldelet As String Dim u As Integer Dim i As Integer Dim O As Integer Dim ii As Long For ii = 1 To Me.ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(ii, 3) ldelet = ShortfallsSheet.Range("N1").Value u = Me.ListBox1.List(ii, 4) i = Me.ListBox1.List(ii, 6) With ItemsSheet.Range("B:B") Set t = .Find(u, LookIn:=xlValues) If Not t Is Nothing Then firsttAddress = t.Address O = ItemsSheet.Cells(t.Row, "D").Value O = O + i d = ItemsSheet.Cells(t.Row, "D").Value d = d j = ItemsSheet.Cells(t.Row, "J").Value j = j purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Cells(t.Row, "D").Value = O 'Me.TextBox7.Value ItemsSheet.Cells(t.Row, "G").Value = Me.ListBox1.List(ii, 9) ItemsSheet.Cells(t.Row, "H").Value = Me.ListBox1.List(ii, 10) ItemsSheet.Cells(t.Row, "I").Value = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time Else purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 3) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 4) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 5) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 6) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 7) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 8) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 9) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 10) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.TextBox13.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.TextBox14.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 1) 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 2) End If End With Next ii If j < d Then ShortfallsSheet.Cells.Rows(ldelet).Delete End If 'Me.TextBox5.Value = Me.ListBox1.List(ii, 4) + 1 Me.TextBox4.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد" End Sub ارجو مساعدتي في المشكلة الاولي وانا احاول حلها وشكرا للجميع

بالاضافة الي في المشتريات بحاول اما يجد العمود يقوم بمسحه ولكن الكود لا ينفذ وهذا هو الكود Dim qp As Integer Dim rp As Integer Dim wp As Integer Dim ep As Integer qp = purchasesSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1 wp = ItemsSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ep = suppliersSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 rp = Me.ListBox1.ListCount Dim t As Range Dim firsttAddress, ldelet As String Dim u As Integer Dim i As Integer Dim O As Integer Dim ii As Long For ii = 1 To Me.ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(ii, 3) ldelet = ShortfallsSheet.Range("N1").Value u = Me.ListBox1.List(ii, 4) i = Me.ListBox1.List(ii, 6) With ItemsSheet.Range("B:B") Set t = .Find(u, LookIn:=xlValues) If Not t Is Nothing Then firsttAddress = t.Address O = ItemsSheet.Cells(t.Row, "D").Value O = O + i d = ItemsSheet.Cells(t.Row, "D").Value d = d j = ItemsSheet.Cells(t.Row, "J").Value j = j purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Cells(t.Row, "D").Value = O 'Me.TextBox7.Value ItemsSheet.Cells(t.Row, "G").Value = Me.ListBox1.List(ii, 9) ItemsSheet.Cells(t.Row, "H").Value = Me.ListBox1.List(ii, 10) ItemsSheet.Cells(t.Row, "I").Value = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time Else purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 0) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 1) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 2) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 3) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 4) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 5) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 6) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 7) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 8) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 9) = Me.ListBox1.List(ii, 9) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = Me.ListBox1.List(ii, 10) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 11) = Me.ListBox1.List(ii, 11) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.ListBox1.List(ii, 12) 'purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.ListBox1.List(ii, 13) purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 12) = Me.TextBox13.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 13) = Me.TextBox14.Value purchasesSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 14) = Time ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Me.ListBox1.List(ii, 3) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Me.ListBox1.List(ii, 4) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.ListBox1.List(ii, 5) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.ListBox1.List(ii, 6) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 7) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 8) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = Me.ListBox1.List(ii, 9) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = Me.ListBox1.List(ii, 10) ItemsSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 8) = Me.ListBox1.List(ii, 11) suppliersSheet.Cells(ep, "A").Value = Me.ComboBox1.Value suppliersSheet.Cells(ep, "B").Value = "المشتريات" suppliersSheet.Cells(ep, "C").Value = Me.TextBox13.Value suppliersSheet.Cells(ep, "D").Value = Me.TextBox14.Value suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value suppliersSheet.Cells(ep, "G").Value = Time 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = Me.TextBox13.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = Me.TextBox14.Value 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = Me.ListBox1.List(ii, 1) 'suppliersSheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = Me.ListBox1.List(ii, 2) End If End With Next ii If j < d Then ShortfallsSheet.Rows(ldelet).Delete End If 'Me.TextBox5.Value = Me.ListBox1.List(ii, 4) + 1 Me.TextBox4.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد" End Sub

نصيحة ممتازة واشكرك علي هذه النصيحة ولكن ظهر لي خطاء في حالة بيع كمية اخري وهي في النواقص تخصم الكمية فقط ولا تضيف البيانات مرة اخري وحللت هذه المكشلة ولكن اذا بعت صنف جديد ليس في القائمة يعطيني هذا الخطا وهذا هو الكود Dim c As Range Dim firstAddress, nfe As String Dim f As Integer Dim x As Integer Dim Y As Integer Dim last, last1, lse As Integer last = SelesSheet.Range("A10000").End(xlUp).Row + 1 last1 = ShortfallsSheet.Range("A10000").End(xlUp).Row + 1 For i = 0 To ListBox1.ListCount - 1 ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(i, 4) lse = ShortfallsSheet.Range("N1").Value f = Me.ListBox1.List(i, 3) x = Me.ListBox1.List(i, 1) With ItemsSheet.Range("B:B") Set c = .Find(f, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Y = ItemsSheet.Cells(c.Row, "D").Value Y = Y - x a = ItemsSheet.Cells(c.Row, "A").Value a = a b = ItemsSheet.Cells(c.Row, "B").Value b = b cc = ItemsSheet.Cells(c.Row, "C").Value cc = cc d = ItemsSheet.Cells(c.Row, "D").Value d = d e = ItemsSheet.Cells(c.Row, "E").Value e = e ff = ItemsSheet.Cells(c.Row, "F").Value ff = ff g = ItemsSheet.Cells(c.Row, "G").Value gg = gg j = ItemsSheet.Cells(c.Row, "J").Value j = j SelesSheet.Cells(last, "I").Value = Me.ListBox1.List(i, 4) SelesSheet.Cells(last, "J").Value = Me.ListBox1.List(i, 3) SelesSheet.Cells(last, "K").Value = Me.ListBox1.List(i, 2) SelesSheet.Cells(last, "L").Value = Me.ListBox1.List(i, 1) SelesSheet.Cells(last, "M").Value = Me.ListBox1.List(i, 0) ItemsSheet.Cells(c.Row, "D").Value = Y last = last + 1 End If End With Next i nfe = ShortfallsSheet.Cells(lse, "A").Value If a = nfe Then ShortfallsSheet.Cells(lse, "D").Value = d - x ElseIf d <= j Then ShortfallsSheet.Cells(last1, "A").Value = a ShortfallsSheet.Cells(last1, "B").Value = b ShortfallsSheet.Cells(last1, "C").Value = cc ShortfallsSheet.Cells(last1, "D").Value = d - x ShortfallsSheet.Cells(last1, "E").Value = e ShortfallsSheet.Cells(last1, "F").Value = ff ShortfallsSheet.Cells(last1, "G").Value = g last1 = last1 + 1 lse = lse + 1 End If Dim ls1 As Integer Dim ls2 As Integer ls1 = SelesSheet.Range("A10000").End(xlUp).Row + 1 ls2 = SelesSheet.Range("I10000").End(xlUp).Row For s = ls1 To ls2 SelesSheet.Cells(ls1, "A").Value = Me.TextBox1.Value SelesSheet.Cells(ls1, "B").Value = Me.TextBox2.Value SelesSheet.Cells(ls1, "C").Value = Me.TextBox3.Value SelesSheet.Cells(ls1, "D").Value = Me.ComboBox1.Value SelesSheet.Cells(ls1, "E").Value = Me.TextBox13.Value SelesSheet.Cells(ls1, "F").Value = Me.TextBox11.Value SelesSheet.Cells(ls1, "G").Value = Me.TextBox12.Value SelesSheet.Cells(ls1, "H").Value = Me.TextBox14.Value ls1 = ls1 + 1 Next s MsgBox "Êã ÇÖÇÝÉ ÇáÈíÇäÇÊ ÈäÌÇÍ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÊÇßíÏ" والله الموفق للجميع dwork.xlsm

السلام عليكم ورحمة الله وبركاته الاساتذة الافاضل انا احتاج مساعدة في عمل هذا الكود انا اريد وقت اضافة صنف يوجد تكست بوكس اسمه اقل كمية يتم الكتابة فيه اقل كمية وحين وصول الكمية اقل من هذا العدد او يساوية يقوم بنقل بيانات الصنف الي الشيت الاخر items.xlsm

تم حل المشكلة شكرا للجميع الحل كان في هذا الكود Private Sub UserForm_Initialize() With Me.ListBox1 .ColumnCount = 14 .RowSource = Empty Sheets("PURCHASES").Select .List = Range(Cells(1, 1), Cells(1, .ColumnCount)).Value .ColumnWidths = "100,100,100,150,100,100,100,100,150,100,100,100,100,100" End With End Sub ممكن ينفع حد وقع في نفس المشكلة وشكرا

شكرا لك

تم الحل بهذا الكود في زر البحث Private Sub CommandButton2_Click() Application.ScreenUpdating = False Me.ListBox1.ColumnWidths = "100,100,100" ListBox1.RowSource = Empty ListBox1.Clear Sheets("suppliers").Select For Each f In Range("a2:a" & Range("a10000").End(xlUp).Row) If f Like textbo1 & "*" Then listed = ListBox1.ListCount ListBox1.AddItem ListBox1.List(listed, 0) = f ListBox1.List(listed, 2) = f.Offset(0, 2) ListBox1.List(listed, 3) = f.Offset(0, 3) End If Next Dim x As Double For i = 0 To ListBox1.ListCount - 1 x = x + ListBox1.List(i, 3) Next i Me.Label9.Visible = True Me.TextBox8.Visible = True TextBox8.Value = x Dim v As Double For Z = 0 To ListBox1.ListCount - 1 v = v + ListBox1.List(Z, 2) Next Z Me.Label8.Visible = True Me.TextBox7.Visible = True TextBox7.Value = v Application.ScreenUpdating = True End Sub شكرا للجميع والله الموفق لي واياكم واذا لم استفيد بمساعدة احد يكفيني ان ممكن احد يستفيد من هذا الكود شكرا

السلام عليكم ورحمة الله وبركاته ...ارجوا من الاساتذة الافاضل مساعدتي في هذا الكود انا اريد اضغط علي زر بحث يقوم بالبحث عن اسم المورد ويظهر 2 تكست بوكس بعدها يجمع كل بيانات المدفوع والمتبقي الي باسم المورد في ال2 تكست بوكس للتوضيح انا الي اريد عمله كالاتي ...اما اضغط اضافة في الفورم بضيف بيانات المورد فقط ...وحين اضافة فاتورة شراء بيترحل بعمود اخر غير العمود المحدد للاضافة ..اما في حالة البحث... فالبحث هيكون باسم المورد فيقوم بجمع قيم المتبقي والمدفوع في التكست بوكس المخفي ...وشكرا ...والله الموفق للجميع مرفق الملف مورد.xlsm

تم بنجاح حل مشكلة الترحيل الي الليست بوكس وقد تم كالتالي من اليوزر فورم قمت بكتابة هذا الكود Private Sub UserForm_Initialize() With Me.ListBox1 .ColumnCount = 14 .List = Range(Cells(1, 1), Cells(1, .ColumnCount)).Value .ColumnWidths = "100,100,100,150,100,100,100,100,150,100,100,100,100,100" End With End Sub وبعدها في زر اضافة للقائمة قمت بهذا الكود Private Sub cmdaddlist_Click() With Me.ListBox1 .AddItem Me.TextBox1 .List(.ListCount - 1, 1) = Me.TextBox2 .List(.ListCount - 1, 2) = Me.TextBox3 .List(.ListCount - 1, 3) = Me.TextBox4 .List(.ListCount - 1, 4) = Me.TextBox5 .List(.ListCount - 1, 5) = Me.TextBox6 .List(.ListCount - 1, 6) = Me.TextBox7 .List(.ListCount - 1, 7) = Me.TextBox8 .List(.ListCount - 1, 8) = Me.TextBox9 .List(.ListCount - 1, 9) = Me.TextBox10 .List(.ListCount - 1, 10) = Me.TextBox11 .List(.ListCount - 1, 11) = Me.TextBox12 .List(.ListCount - 1, 12) = Me.TextBox13 .List(.ListCount - 1, 13) = Me.TextBox14 Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" End With End Sub والان يوجد مشكلة بسيطة ان رؤس الاعمدة الخاصة بالمشتريات لا تظهر الا علي الشيت المفتوح حاليا بمعني لو كنت فاتح شيت تاني غير المشتريات يجبلي رؤوس المشتريات اكون شاكر جدا لو حد حللي المشكلة دي وشكرا

وعليكم السلام ورحمه الله وبركاته اخي الكريم علي حد علمي هذه المشكلة لها ثلاث عوام الاول الرامات الثاني كارت الشاشة الاخير نسخة الويندوز حضرتك وضحت انك جربت تغير كارت الشاشة ومازالت المشكلة قائمة إذا هيا أما الرامات أو الويندوز والله اعلم اتمني التوفيق في حل هذه المشكلة

وعليكم السلام ورحمه الله وبركاته جرب يا اخي تمسح ال2016 وال2019 معا من control panel وبعدين اضغط علي programs and feature وامسح الاثنين وبعدين نزل ال 2019 لوحده وانشاء الله المشكلة هتتحل ومبرووك عليك

السادة الاساتذه السلام عليكم ورحمة الله وبركاته هل يوجد حل لترحيل البيانات من التيكيست بوكس الي الليست بوكس بالضغط علي زر اضافة للقائمةمع العلم ان عدد التيكست بوكس 14 بمعدل 14 عمود ومن الليست بوكس الي الشيت بعد الضغط علي زر اضافة القائمة في Purchasesform الموضوع ده ممكن صعب لكن مش مستحيل فلو حد عنده فكرة او طريقة تانيةاو مساعدة يكتبهالي انا عموما وصلت لحل جزئي في مشكلة ترحيل البيانات من التيكست بوكس الي الليست بوكس بالكود ده بس طبعا ده بيضيف مرة واحدة بس ولو مليت بيانات تانية بيشيل القديم مش بيزود عليه وانا شاكر جدا للجميع Private Sub cmdaddlist_Click() Dim xx(1, 14) xx(0, 1) = Me.TextBox1 xx(0, 2) = Me.TextBox2 xx(0, 3) = Me.TextBox3 xx(0, 4) = Me.TextBox4 xx(0, 5) = Me.TextBox5 xx(0, 6) = Me.TextBox6 xx(0, 7) = Me.TextBox7 xx(0, 8) = Me.TextBox8 xx(0, 9) = Me.TextBox9 xx(0, 10) = Me.TextBox10 xx(0, 11) = Me.TextBox11 xx(0, 12) = Me.TextBox12 xx(0, 13) = Me.TextBox13 xx(0, 14) = Me.TextBox14 ListBox1.List() = xx Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" End Sub dwork.xlsm

للرفع

للتوضيح اناحاولت علي قد ما اقدر احل المشكلة بس مش عارف محتاج بجد حد يساعدني عموما انا ضفت زر جديد لاضافة البيانات الي في الليست بوكس للشيت وطبعا البيانات كاملة مش هتروح لليست بوكس بسبب ان الاعمدة اكثر من 10 وقدرت اوصل البيانات الي هما 10 اعمدة فا في 4 اعمدة مش عارف اتصرف فيهم فياريت حد يشوفلي حل بحيث ينفذ نفس متغيرات ومعادلات الكود المشكلة الثانية الي بتحصل ان عندي قيمة الكمية*قيمة سعر الشراء الناتج بيجي في المتبقي والمدفوع اول ما يتكتب في ارقام يطرح من المتبقي المشكلة ان لو اخطائت وكتبت مثلا سعر الشراء غلط بعد ما طلع حاصل الضرب في المتبقي لو رجعت عدلت علي قيمة سعر الشراء بيضيف كأني ضفت كمية جديدة بسعر جديد ويضيف القيمة القديمة في المتبقي مع الجديدة ده كود معادلة الضرب والطرح Private Sub TextBox10_AfterUpdate() sm = Me.TextBox14.Value x1 = Val(Me.TextBox10.Value) * Val(Me.TextBox7.Value) Me.TextBox14.Value = Val(sm) + Val(x1) End Sub Private Sub TextBox13_AfterUpdate() Dim xai As Integer xai = Me.TextBox14.Value = Val(sm) + Val(x1) bi = Me.TextBox14.Value b1 = Val(Me.TextBox13.Value) - Val(Me.TextBox14.Value) Me.TextBox14.Value = Val(xai) - Val(b1) End Sub TextBox10 هو تكست سعر الشراء TextBox7 هو تكست الكمية TextBox13 هو تكست المدفوع TextBox14 هو تكست المتبقي ده الكود الي ضفته للزر الجديد Dim qp As Integer Dim rp As Integer Dim wp As Integer Dim ep As Integer qp = purchasesSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1 wp = ItemsSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 ep = suppliersSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 rp = Me.ListBox1.ListCount Dim t As Range Dim firsttAddress As String Dim u As Integer Dim i As Integer Dim O As Integer u = Me.ListBox1.List(ListBox1.ListCount - 1, 1) i = Me.ListBox1.List(ListBox1.ListCount - 1, 3) With purchasesSheet.Range("E:E") Set t = .Find(u, LookIn:=xlValues) If Not t Is Nothing Then firsttAddress = t.Address O = purchasesSheet.Cells(t.Row, "G").Value O = O + i purchasesSheet.Cells(qp, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 0) purchasesSheet.Cells(qp, "E").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 1) purchasesSheet.Cells(qp, "F").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 2) purchasesSheet.Cells(qp, "G").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 3) purchasesSheet.Cells(qp, "I").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) purchasesSheet.Cells(qp, "J").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 5) purchasesSheet.Cells(qp, "K").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 6) purchasesSheet.Cells(qp, "L").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 7) purchasesSheet.Cells(qp, "M").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) purchasesSheet.Cells(qp, "N").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) ItemsSheet.Cells(t.Row, "D").Value = O 'Me.TextBox7.Value suppliersSheet.Cells(ep, "A").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) suppliersSheet.Cells(ep, "C").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) suppliersSheet.Cells(ep, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) 'suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value 'suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value Else purchasesSheet.Cells(qp, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 0) purchasesSheet.Cells(qp, "E").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 1) purchasesSheet.Cells(qp, "F").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 2) purchasesSheet.Cells(qp, "G").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 3) purchasesSheet.Cells(qp, "I").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) purchasesSheet.Cells(qp, "J").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 5) purchasesSheet.Cells(qp, "K").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 6) purchasesSheet.Cells(qp, "L").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 7) purchasesSheet.Cells(qp, "M").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) purchasesSheet.Cells(qp, "N").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) ItemsSheet.Cells(wp, "A").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 0) ItemsSheet.Cells(wp, "B").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 1) ItemsSheet.Cells(wp, "C").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 2) ItemsSheet.Cells(wp, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 3) ItemsSheet.Cells(wp, "F").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) ItemsSheet.Cells(wp, "G").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 5) ItemsSheet.Cells(wp, "H").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 6) ItemsSheet.Cells(wp, "i").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 7) suppliersSheet.Cells(ep, "A").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 4) suppliersSheet.Cells(ep, "C").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 8) suppliersSheet.Cells(ep, "D").Value = Me.ListBox1.List(ListBox1.ListCount - 1, 9) 'suppliersSheet.Cells(ep, "E").Value = Me.TextBox2.Value 'suppliersSheet.Cells(ep, "F").Value = Me.TextBox3.Value End If End With Me.TextBox5.Value = purchasesSheet.Cells(qp, "E").Value + 1 Me.TextBox2.Value = Date Me.TextBox3.Value = Format(Date, "ddd") Me.TextBox4.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" 'Me.TextBox9.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تاكيد" End Sub مرفق ملف الاكسيل dwork.xlsm

المشكلة الأولي تم حلها للتوضيح زر الاضافة عاوزه يعمل حاجتين عاوزه يضيف عادي البيانات زي ما هو دلوقتي في حالة بضيف صنف واحد بس اما الحاجة التانية لو في بيانات في الليست بوكس وضغط اضافة يعمل اضافة بنفس منطق اضافة البيانات الي في التكست بوكس بمعني عاوز الكود ده يضيف الي في الليست بوكس Private Sub cmdsave_Click() Dim ap As Integer Dim ip As Integer ap = purchasesSheet.Cells(Rows.Count, "c").End(xlUp).Row + 1 ip = ItemsSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 Dim C As Range Dim firstAddress As String Dim f As Integer Dim x As Integer Dim Y As Integer f = Me.TextBox5.Value x = Me.TextBox7.Value With purchasesSheet.Range("E:E") Set C = .Find(f, LookIn:=xlValues) If Not C Is Nothing Then firstAddress = C.Address Y = purchasesSheet.Cells(C.Row, "G").Value Y = Y + x purchasesSheet.Cells(ap, "A").Value = Me.TextBox1.Value purchasesSheet.Cells(ap, "B").Value = CDate(TextBox2.Value) purchasesSheet.Cells(ap, "C").Value = Me.TextBox3.Value purchasesSheet.Cells(ap, "D").Value = Me.TextBox4.Value purchasesSheet.Cells(ap, "E").Value = Me.TextBox5.Value purchasesSheet.Cells(ap, "F").Value = Me.TextBox6.Value purchasesSheet.Cells(ap, "G").Value = Me.TextBox7.Value purchasesSheet.Cells(ap, "H").Value = Me.TextBox8.Value purchasesSheet.Cells(ap, "I").Value = Me.TextBox9.Value purchasesSheet.Cells(ap, "J").Value = Me.TextBox10.Value purchasesSheet.Cells(ap, "K").Value = Me.TextBox11.Value purchasesSheet.Cells(ap, "L").Value = Me.TextBox12.Value purchasesSheet.Cells(ap, "M").Value = Me.TextBox13.Value purchasesSheet.Cells(ap, "N").Value = Me.TextBox14.Value ItemsSheet.Cells(C.Row, "D").Value = Y 'Me.TextBox7.Value Else purchasesSheet.Cells(ap, "A").Value = Me.TextBox1.Value purchasesSheet.Cells(ap, "B").Value = CDate(TextBox2.Value) purchasesSheet.Cells(ap, "C").Value = Me.TextBox3.Value purchasesSheet.Cells(ap, "D").Value = Me.TextBox4.Value purchasesSheet.Cells(ap, "E").Value = Me.TextBox5.Value purchasesSheet.Cells(ap, "F").Value = Me.TextBox6.Value purchasesSheet.Cells(ap, "G").Value = Me.TextBox7.Value purchasesSheet.Cells(ap, "H").Value = Me.TextBox8.Value purchasesSheet.Cells(ap, "I").Value = Me.TextBox9.Value purchasesSheet.Cells(ap, "J").Value = Me.TextBox10.Value purchasesSheet.Cells(ap, "K").Value = Me.TextBox11.Value purchasesSheet.Cells(ap, "L").Value = Me.TextBox12.Value purchasesSheet.Cells(ap, "M").Value = Me.TextBox13.Value purchasesSheet.Cells(ap, "N").Value = Me.TextBox14.Value ItemsSheet.Cells(ip, "A").Value = Me.TextBox4.Value ItemsSheet.Cells(ip, "B").Value = Me.TextBox5.Value ItemsSheet.Cells(ip, "C").Value = Me.TextBox6.Value ItemsSheet.Cells(ip, "D").Value = Me.TextBox7.Value ItemsSheet.Cells(ip, "E").Value = Me.TextBox8.Value ItemsSheet.Cells(ip, "F").Value = Me.TextBox9.Value ItemsSheet.Cells(ip, "G").Value = Me.TextBox10.Value ItemsSheet.Cells(ip, "H").Value = Me.TextBox11.Value ItemsSheet.Cells(ip, "i").Value = Me.TextBox12.Value End If End With Me.TextBox1.Value = "" Me.TextBox2.Value = "" 'Me.TextBox2.Value = "" 'Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox9.Value = "" Me.TextBox10.Value = "" Me.TextBox11.Value = "" Me.TextBox12.Value = "" Me.TextBox13.Value = "" Me.TextBox14.Value = "" MsgBox "تم اضافة البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تاكيد" End Sub طبعا المشكلة الي بتقابلني ان الليست بوكس لا يستوعب اكثر من 10 اعمدة

السلام عليكم انا عندي 3 مشاكل احتاج لحلها المشكلة الاولي اما المشكلة الثانية اما المشكلة الثالثة والاخيرة dwork.xlsm

شكرا لحضرتك تم حلها

السلام عليكم ورحمة الله وبركاته المشكلة عندي كما موضحها في الصورة زي ما انا موضح بضيف الكمية طيعي بكتب سعر الشراء طبيعي بيجيب في المتبقي حاصل ضرب الكمية في سعر الشراء المفروض اما اكتب قيمة في المدفوع يطرحها من المتبقي وبعد كله يبقي صحيح اضغط علي اضافة في القائمة يقوم باضافة البيانات في الليس بوكس فقط واما اضغط اضافة يرحل البيانات الي في الليست بوكس في الشيت اسف علي المطاولة dwork.xlsm

في البداية شكرا لمساعدة حضرتكوشكرا علي الكود انا قدرت اعدل عليه علشان انفذ الطلب الي انا محتاجه والتعديل الي قمت بيه هو ده Y = purchasesSheet.Cells(c.Row, "G").Value Y = Y + x purchasesSheet.Cells(ap, "A").Value = Me.TextBox1.Value purchasesSheet.Cells(ap, "B").Value = CDate(TextBox2.Value) purchasesSheet.Cells(ap, "C").Value = Me.TextBox3.Value purchasesSheet.Cells(ap, "D").Value = Me.TextBox4.Value purchasesSheet.Cells(ap, "E").Value = Me.TextBox5.Value purchasesSheet.Cells(ap, "F").Value = Me.TextBox6.Value purchasesSheet.Cells(ap, "G").Value = Me.TextBox7.Value purchasesSheet.Cells(ap, "H").Value = Me.TextBox8.Value purchasesSheet.Cells(ap, "I").Value = Me.TextBox9.Value purchasesSheet.Cells(ap, "J").Value = Me.TextBox10.Value purchasesSheet.Cells(ap, "K").Value = Me.TextBox11.Value purchasesSheet.Cells(ap, "L").Value = Me.TextBox12.Value purchasesSheet.Cells(ap, "M").Value = Me.TextBox13.Value purchasesSheet.Cells(ap, "N").Value = Me.TextBox14.Value ItemsSheet.Cells(c.Row, "D").Value = Y 'Me.TextBox7.Value ItemsSheet.Cells(c.Row, "D").Value = Y 'Me.TextBox7.Value كان لازم تضاف علشان تعمل المعادلة في شيت الاصناف ..شكرا لحضرتك مرة اخري علي مجهودك

طبعا في البداية شكرا علي مجهودك حضرتك الكود عمل الي أنا عاوزه في حالة واحدة ومستمر عليها الي كنت عاوزه كالتالي في حالة إضافة البيانات الخاصة بالشراء تضاف في شيت المشتريات اولا وبعد ما يضاف يشوف الي إضافة ده اسمه او الكود الخاص به موجود في الأصناف ولا لا في حالة وجوده نجمع الكمية الي في المشتريات مع الكمية الي في الأصناف في حالة عدم وجود الصنف نضيفه او نرحل من بداية اسم الصنف حتي الاخر شكرا لتعب حضرتك

السلام عليكم ورحمه الله ..عندي طلب معقد شوية أنا بستخدم اكواد ال VBA في الاكسيل بحاول اعمل في حالة إضافة فاتورة شراء إذا كان اسم الصنف المضاف في الفاتورة مطابق لاسم الصنف الموجود في الأصناف يقوم بجمع الكمية الموجودة في الأصناف مع الكمية الجديدة ويكون الإجمالي في الأصناف للتوضيح أنا عاوز اول ما اضغط علي إضافة في المشتريات هيضيف البيانات عادي في شيت المشتريات بس عاوزه اول ما يضيف الصنف في حالة اسم الصنف أو كود الصنف موجود في شيت الأصناف الي اسمه items Sheet يقوم بالذهاب الي خلية الكمية ويضيف كمية المشتريات علي كمية الاصناف الموجودة بالفعل طبعا لو عرفت اعمل كود الاضافة في المشتريات سهل اعمل العكس في المبيعات وشكرا dwork.xlsm