mahmoud nasr alhasany

لقد وجدت حل ولاكن القيم العددية للاسف غير مظبوطة Private Sub CommandButton26_Click() Dim total200 As Integer, total100 As Integer, total50 As Integer, totalValue As Integer Dim percent200 As Double, percent100 As Double, percent50 As Double, halfPercent As Double Dim group1Total As Integer, group2Total As Integer Dim CalculateTotal As Integer ' التحقق من صحة المدخلات If Not IsNumeric(TextBox11.Text) Or Not IsNumeric(TextBox12.Text) Then ' MessageBox.Show ("الرجاء إدخال قيم عددية في حقل الإجمالي") Exit Sub End If ' التحقق من صحة البيانات If total200 < 0 Or total100 < 0 Or total50 < 0 Then MessageBox.Show ("الرجاء إدخال قيم موجبة") Exit Sub End If If group1Total + group2Total < totalValue Then MessageBox.Show ("مجموع القيم المستهدفة أقل من مجموع القيم المتاحة") Exit Sub End If ' جمع قيم الفئات total200 = Val(TextBox1.Text) + Val(TextBox4.Text) + Val(TextBox7.Text) total100 = Val(TextBox2.Text) + Val(TextBox5.Text) + Val(TextBox8.Text) total50 = Val(TextBox3.Text) + Val(TextBox6.Text) + Val(TextBox9.Text) totalValue = total200 * 200 + total100 * 100 + total50 * 50 ' حساب النسبة المئوية لكل فئة percent200 = total200 * 200 / totalValue percent100 = total100 * 100 / totalValue percent50 = total50 * 50 / totalValue ' توزيع النسب المئوية على المجموعتين group1Total = Val(TextBox11.Text) group2Total = Val(TextBox12.Text) halfPercent = 0.5 ' توزيع فئة 200 TextBox4.Text = CInt((percent200 * halfPercent) * group1Total / 200) TextBox7.Text = CInt((percent200 * (1 - halfPercent)) * group2Total / 200) ' توزيع فئة 100 TextBox5.Text = CInt((percent100 * halfPercent) * group1Total / 100) TextBox8.Text = CInt((percent100 * (1 - halfPercent)) * group2Total / 100) ' توزيع فئة 50 TextBox6.Text = CInt((percent50 * halfPercent) * group1Total / 50) TextBox9.Text = CInt((percent50 * (1 - halfPercent)) * group2Total / 50) ' حساب القيم العددية الإجمالية Me.TextBox58 = Val(TextBox1) + Val(TextBox2) + Val(TextBox3) Me.TextBox59 = Val(TextBox4) + Val(TextBox5) + Val(TextBox6) Me.TextBox60 = Val(TextBox7) + Val(TextBox8) + Val(TextBox9) ' حساب القيم النقدية الإجمالية باستخدام الدالة Me.TextBox13.Value = Val(Me.TextBox1.Value) * 200 Me.TextBox14.Value = Val(Me.TextBox2.Value) * 100 Me.TextBox15.Value = Val(Me.TextBox3.Value) * 50 Me.TextBox16.Value = Val(Me.TextBox4.Value) * 200 Me.TextBox17.Value = Val(Me.TextBox5.Value) * 100 Me.TextBox18.Value = Val(Me.TextBox6.Value) * 50 Me.TextBox19.Value = Val(Me.TextBox7.Value) * 200 Me.TextBox20.Value = Val(Me.TextBox8.Value) * 100 Me.TextBox21.Value = Val(Me.TextBox9.Value) * 50 End Sub انظر الصورة الاولى غير مظبوطة اما الصورة الثانية اريدها هكذا

شكرا جزيلا لك ا/ محمد هشام انا لا اقصد اوزان فأنها خطاء كتابى نظرا لانى كنت اكتب بالهاتف انا اقصد ان الاعداد الفردية التى ادرجتها فى textbox1,2,3 تعادل قيمة النقدية فى textbox10 =2000 * TextBox1: 10 *200 =1500 * TextBox2: 15 * 100 =400 * TextBox3: 8 * 50 لو وضعنا القيمة النقدية فى textbox11 ,ولنفترض 2000 والقيمة النقدية فى textbox12 ,ولنفترض 1900 اريد الارقام العددية فى textbox1,2,3 توزع عشوائى الى textbox4,5,6 وفقا للقيمة فى textbo11 وايضا توزع الى textbox7,8,9 وفقا للقيمة فى textbox12 وهذا هو المطلوب كما سأوضحة فى الصورتان قبل وبعد

الفكرة مثلا هى عند وضع القيم العددية فى * TextBox1: 10 *200 * TextBox2: 15 * 100 * TextBox3: 8 * 50 تكون مجموع الناتج فى textbox10 3900 اريد وضع القيم النقدية textbox11 1900 ليقوم بتوزيع قيم عدديه على حسب الارقام المقابل لها فى textbox1,2,3 وتوزيعها الى * TextBox4: 5 * TextBox5: 7 * TextBox6: 4 وكذلك على حسب القيم النقدية textbox12 2000 على حسب الارقام المقابل لها فى textbox1,2,3 وتوزيعها الى * TextBox7: 5 * TextBox 8: 8 * TextBox9: 4 * قراءة القيم: نقوم بقراءة القيم العددية من النصوص TextBox1, TextBox2, TextBox3 والقيم النقدية من TextBox11 و TextBox12. * حساب الأوزان النسبية: نحسب الوزن النسبي لكل قيمة عددية بناءً على قيمتها الإجمالية. * حساب المبالغ الموزعة: نحسب المبلغ الذي سيتم توزيعه لكل نص بناءً على الوزن النسبي والقيمة النقدية. * توزيع القيم: نقوم بتعيين القيم المحسوبة في النصوص المستهدفة (TextBox4 إلى TextBox9).

الفكرة مثلا هى عند وضع القيم العددية فى * TextBox1: 10 *200 * TextBox2: 15 * 100 * TextBox3: 8 * 50 تكون مجموع الناتج فى textbox10 3900 اريد وضع القيم النقدية textbox11 1900 ليقوم بتوزيع قيم عدديه على حسب الارقام المقابل لها فى textbox1,2,3 وتوزيعها الى TextBox4: 5 TextBox5: 7 TextBox6: 4 وكذلك على حسب القيم النقدية textbox12 2000 ليقوم بتوزيع قيم عدديه على حسب الارقام المقابل لها فى textbox1,2,3 وتوزيعها الى TextBox7: 5 TextBox8: 8 TextBox9: 4 ويكون خصم القيم العدديه متساويه مع القيم العددية فى نقديه ١ ونقديه ٢

احسنت ا/محمد هشام هل يمكن تعديل الكود رجاء بحيث لو أن القيمة الإجمالية مثلا فى textbox10 هى 3900 بحيث اتحكم فى وضع القيمة النقديه ١ مثلا 1000 والقيمة النقدية ٢ 2900 وتوزيع القيمة فئات الاعداد على حسب القيمة المدرجة الذى وضعتها وشكرا

الف شكر ا/ محمد هشام على الاهتمام احب أنوه على ملحوظة فى نقدية ١ اولا فى فئة 100 *7=700 وليست 800 ثانيا بالنسبة للمبلغ المفترض فى textbox10 يكون الإجمالي 3900 لانه هو المبلغ الأساسى الذى يتم توزيع المبالغ العددية عشوائى وبالتساوى إلى نقديه ا ونقديه ٢ أما بالنسبة للمبلغ المفترض فى textbox11 يكون الإجمالي 1900 أما بالنسبة للمبلغ المفترض فى textbox12 يكون الإجمالي 2000 وهذا هو المطلوب

السلام عليكم ورحمة الله وبركاتة لقد صممت فورم به اجمالى المبلغ مع قيم العددية فئات يتم توزيعها على مجموعتين نقدية 1 ونقدية 2 ويوجد المجموع الكلى قبل التوزيع فى Textbox10 ويوجد المجموع نقدية 1 فى Textbox11 ويوجد المجموع نقدية 2 فى Textbox12 ولاكن القيم النقدية فى textbox10,11,12 غير مظبوطة مع المجموعات كما هى مدرجة فى الصورة المرفقة مع العلم انى كنت اريد توزيع القيم العددية الى نقدية 1 و2 على حسب مجموع القيم النقدية وليس العددية فى textbox11,12 Private Sub CommandButton24_Click() Dim قيمة1 As Long, قيمة2 As Long, قيمة3 As Long Dim نصف_القيمة1 As Double, نصف_القيمة2 As Double, نصف_القيمة3 As Double Dim إجمالي_نقدية1 As Double, إجمالي_نقدية2 As Double, إجمالي_كلية As Double Dim نسبة_نقدية1 As Double, نسبة_نقدية2 As Double ' التحقق من صحة الإدخال (يمكن إضافة المزيد من التحقيقات حسب الحاجة) If Not IsNumeric(TextBox1.Value) Or Not IsNumeric(TextBox2.Value) Or Not IsNumeric(TextBox3.Value) Then MsgBox "الرجاء إدخال أعداد صحيحة موجبة فقط." Exit Sub End If If Val(TextBox1.Value) <= 0 Or Val(TextBox2.Value) <= 0 Or Val(TextBox3.Value) <= 0 Then MsgBox "الرجاء إدخال أعداد أكبر من الصفر." Exit Sub End If ' قراءة القيم من النصوص قيمة1 = Val(TextBox1.Value) قيمة2 = Val(TextBox2.Value) قيمة3 = Val(TextBox3.Value) ' حساب النصف لكل قيمة نصف_القيمة1 = قيمة1 / 2 نصف_القيمة2 = قيمة2 / 2 نصف_القيمة3 = قيمة3 / 2 ' تحويل الأجزاء العشرية إلى أعداد صحيحة وتوزيع الباقي TextBox4.Value = Int(نصف_القيمة1) TextBox5.Value = Int(نصف_القيمة2) TextBox6.Value = Int(نصف_القيمة3) TextBox7.Value = قيمة1 - TextBox4.Value TextBox8.Value = قيمة2 - TextBox5.Value TextBox9.Value = قيمة3 - TextBox6.Value Me.TextBox13.Value = Val(Me.TextBox1.Value) * 200 Me.TextBox14.Value = Val(Me.TextBox2.Value) * 100 Me.TextBox15.Value = Val(Me.TextBox3.Value) * 50 Me.TextBox16.Value = Val(Me.TextBox4.Value) * 200 Me.TextBox17.Value = Val(Me.TextBox5.Value) * 100 Me.TextBox18.Value = Val(Me.TextBox6.Value) * 50 Me.TextBox19.Value = Val(Me.TextBox7.Value) * 200 Me.TextBox20.Value = Val(Me.TextBox8.Value) * 100 Me.TextBox21.Value = Val(Me.TextBox9.Value) * 50 ' حساب القيم الإجمالية (مع التعديل) إجمالي_نقدية1 = TextBox13.Value * Val(TextBox4.Value) + TextBox14.Value * Val(TextBox5.Value) + TextBox15.Value * Val(TextBox6.Value) إجمالي_نقدية2 = TextBox13.Value * Val(TextBox7.Value) + TextBox14.Value * Val(TextBox8.Value) + TextBox15.Value * Val(TextBox9.Value) إجمالي_كلية = إجمالي_نقدية1 + إجمالي_نقدية2 If إجمالي_كلية <> 0 Then نسبة_نقدية1 = إجمالي_نقدية1 / إجمالي_كلية نسبة_نقدية2 = إجمالي_نقدية2 / إجمالي_كلية Else MsgBox "حدث خطأ: الإجمالي الكلي يساوي صفرًا." Exit Sub End If ' بدلاً من توزيع القيم بناءً على النسبة المئوية، يمكن توزيعها بالتساوي TextBox11.Value = (نصف_القيمة1 + نصف_القيمة2 + نصف_القيمة3) / 2 TextBox12.Value = (نصف_القيمة1 + نصف_القيمة2 + نصف_القيمة3) / 2 TextBox11.Value = Format(إجمالي_نقدية1, "$#,##0.00") TextBox12.Value = Format(إجمالي_نقدية2, "$#,##0.00") TextBox10.Value = Format(إجمالي_كلية, "$#,##0.00") Me.TextBox59 = Val(TextBox4) + Val(TextBox5) + Val(TextBox6) Me.TextBox60 = Val(TextBox7) + Val(TextBox8) + Val(TextBox9) MsgBox "تم التوزيع بنجاح." End Sub توزيع فئات نقدية.xlsm

الف شكر / محمد هشام على التوضيح بعض النقاط توضيحا جيدا وجزاك الله عنا خير الجزاء وهذا الكود بعد اضافة خيار التاريخ اذا لزم الامر Private Sub CommandButton1_Click() Dim ws As Worksheet Dim lastRow As Long Dim searchValue1 As String Dim searchValue2 As String Dim currentRow As Long Dim DateMin As Date Dim DateMax As Date Dim includeDates As Boolean ' تحديد ورقة العمل Set ws = Worksheets("Sheet3") ' الحصول على القيم من عناصر التحكم searchValue1 = ComboBox1.Value searchValue2 = ComboBox3.Value If IsDate(TextBox1.Value) Then DateMin = CDate(TextBox1.Value) If IsDate(TextBox2.Value) Then DateMax = CDate(TextBox2.Value) includeDates = CheckBox1.Value ' تحديد قيمة مربع الاختيار ' تحديد الصف الأخير lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' مسح قائمة النتائج وتحديد عرض الأعمدة With ListBox2 .Clear .ColumnCount = 6 .ColumnWidths = "35;60;45;40;65;40" .Font.Size = 10 End With ' البحث عن البيانات وتعبئة القائمة currentRow = 0 For i = 2 To lastRow ' التحقق من الشروط If ws.Cells(i, 5).Value = searchValue1 And _ ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" And _ (Not includeDates Or (ws.Cells(i, 6) >= DateMin And ws.Cells(i, 6) <= DateMax)) Then ' إضافة البيانات إلى القائمة ListBox2.AddItem ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ' سعر ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ' كمية المخزون ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ' اسم المخزن 'ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value ' تاريخ نهاية الصنف ListBox2.List(currentRow, 5) = Format(ws.Cells(i, 6).Value, "dd/mm/yyyy") ' تاريخ نهاية الصنف currentRow = currentRow + 1 End If Next i If ListBox2.ListCount = 0 Then MsgBox "لم يتم العثور على نتائج" End If TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount & ")" Call TOtal End Sub

شكرا لك محمد هشام. الكود يعمل جيدا ولاكن اريد اظهار البيانات داخل رؤوس الاعمدة ListBox2.ColumnHeads = True Private Sub CommandButton1_Click() Dim ws As Worksheet Dim lastRow As Long Dim searchValue1 As String Dim searchValue2 As String Dim currentRow As Long Dim colHeaders As Variant searchValue1 = ComboBox1.Value searchValue2 = ComboBox3.Value Set ws = Worksheets("Sheet3") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' تعريف رؤوس الأعمدة colHeaders = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف") colWidths = "35;60;45;40;65;40" With ListBox2 .Clear .ColumnCount = UBound(colHeaders) + 1 .ColumnWidths = colWidths .Font.Size = 10 .ColumnHeads = True .AddItem For i = 0 To UBound(colHeaders) .List(0, i) = colHeaders(i) Next i End With currentRow = 1 For i = 2 To lastRow If ws.Cells(i, 5).Value = searchValue1 And _ ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then ListBox2.AddItem ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value currentRow = currentRow + 1 End If Next i If ListBox2.ListCount = 1 Then MsgBox "لم يتم العثور على نتائج" End If TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount - 1 & ")" Call TOtal End Sub

السلام عليكم ورحمة الله وبركاتة الرجاء مساعدتى انها عملية بحث بين شرطين او اكثر اسم المخزن وكود الصنف والتاريخ اذا لزم الامر واظهار النتائج فى الليست بوكس 2 وعند عملية البحث لايدرج بيانات رؤوس الاعمدة داخل الليست بوكس2 فما الخطاء فى الكود Private Sub CommandButton1_Click() Dim ws As Worksheet Dim lastRow As Long Dim searchValue1 As String Dim searchValue2 As String Dim currentRow As Long searchValue1 = ComboBox1.Value searchValue2 = ComboBox3.Value Set ws = Worksheets("Sheet3") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' ' تعريف رؤوس الأعمدة وعروضها ' colHeaders = Split("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف") ' 'colHeaders = Array("اسم المخزن", "كود", "صنف", "سعر", "كمية المخزون", "تاريخ نهاية الصنف") colWidths = "40;50;50;40;60;40" ' تهيئة ListBox2 With ListBox2 .Clear '.columnCount = UBound(colHeaders) + 1 ' عدد الأعمدة + 1 لرأس العمود .columnWidths = colWidths .columnCount = 6 .Font.Size = 10 .ColumnHeads = True ' تعيين رؤوس الأعمدة بشكل صريح (اختياري) ' For i = 0 To UBound(colHeaders) ' ' .List(.ListCount - 1, i) = colHeaders(i) ' ListBox2.AddItem colHeaders(i) ' Next i End With 'ListBox2.Clear currentRow = 0 For i = 2 To lastRow If ws.Cells(i, 5).Value = searchValue1 And _ ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then ListBox2.AddItem ws.Cells(i, 1).Value ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value currentRow = currentRow + 1 End If Next i If ListBox2.ListCount = 0 Then MsgBox "لم يتم العثور على نتائج" End If End Sub عملية بحث بشرطين او اكثر.xlsm

ماشاء الله احسنت ا/ هشام محمد انت رائع حقا ماشاء الله احسنت ا/ هشام محمد انت رائع حقا

اولا اشكر السيدان الفضلاء الرائعان عبدالله بشير عبدالله محمد هشام. على هذا المجهود الرائع ولاكن هذا الكود مختلف عن ما الملف السابق الذى اشرت عليه واردت ان اقوم بعملية ترتيب ابجدى من خلال الكود هذا ولاكن توجد مشكلة ان عملية الترتيب ابجدى فى هذا الملف الذى تم التعديل علية بواستطكم مختلف لانه يعمل على الترتيب هكذا مخزن 1 مخزن 10 مخزن 11 مخزن 12 مخزن 13 مخزن 14 مخزن 2 مخزن 3 مخزن 4 مخزن 5 مخزن 6 مخزن 7 مخزن 8 مخزن 9 وانا اردت ان تكون الترتيب فى الكومبوبوكس 1و2 هكذا مخزن 1 مخزن 2 مخزن 3 مخزن 4 مخزن 5 مخزن 6 مخزن 7 مخزن 8 مخزن 9 مخزن 10 مخزن 11 مخزن 12 مخزن 13 مخزن 14 وشكرا جزيلا لكم على انكم وجدت وقتا لمساعدتنا

رجاء مساعدتى فى ترتيب البيانات فى combobox1,2 ترتيبا ابجديا Sub FillComboBoxesWithoutDuplicates() Dim ws As Worksheet Dim i As Long, lastRow As Long Dim storeNames As Collection Dim storeName As String ' تحديد ورقة العمل Set ws = ThisWorkbook.Sheets("Sheet3") ' تحديد آخر صف يحتوي على بيانات lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row ' إنشاء مجموعة لتخزين الأسماء الفريدة Set storeNames = New Collection ' قراءة الأسماء وإضافتها إلى المجموعة (مع التعامل مع التكرارات) On Error Resume Next For i = 2 To lastRow storeName = ws.Cells(i, "D").Value storeNames.Add storeName, storeName On Error GoTo 0 Next i On Error GoTo 0 ' مسح ComboBox1 و ComboBox2 ComboBox1.Clear ComboBox2.Clear ' ملء ComboBox1 و ComboBox2 بالأسماء الفريدة For Each storeName In storeNames ComboBox1.AddItem storeName ComboBox2.AddItem storeName Next storeName End Sub Private Sub ComboBox1_Change() Dim selectedItem As String selectedItem = ComboBox1.Value ' الحصول على القيمة المحددة في ComboBox1 ' البحث عن العنصر في ComboBox2 وإزالته Dim i As Long For i = ComboBox2.ListCount - 1 To 0 Step -1 If ComboBox2.List(i) = selectedItem Then ComboBox2.RemoveItem i Exit For End If Next i End Sub Private Sub UserForm_Initialize() Dim ws As Worksheet Dim i As Long, lastRow As Long Dim storeNames As New Collection Dim storeName As Variant Set ws = ThisWorkbook.Sheets("Sheet3") lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row On Error Resume Next For i = 2 To lastRow storeName = ws.Cells(i, "D").Value If Not IsEmpty(storeName) Then storeNames.Add storeName, storeName End If Next i On Error GoTo 0 ComboBox1.Clear ComboBox2.Clear For Each storeName In storeNames ComboBox1.AddItem storeName ComboBox2.AddItem storeName Next storeName End Sub ترتيب البيانات ابجديا.xlsm

لقد وجدت الحل أن الكود صحيح ولاكن العمليه التى كنت أقوم بتعديل عليها كان على رقم فاتورة معينة وهى ٢٧ وكانت كود الصنف مكرر كانت المشكله فى كود الصنف فى شيت البيانات عزرا لقد مرت فترة طويله فى معرفة الخطاء نظرا لانى كنت مشغول فى الفتره الماضيه ولم أتفرغ لمعرفة الخطاء وسأقوم برفع الملف

Private Sub CommandButton2_Click() ' التحقق من وجود ورقة العمل "Transferts" If Not WorksheetExists("Log") Then MsgBox "غير موجودة" & " " & "Transferts" & " ورقة العمل", vbCritical, "خطأ" Exit Sub End If ' التحقق من القيم الفارغة If ListBox1.ListIndex = -1 Or (ComboBox3.Value = "" And Me.TextBox1.Value = "") Then Exit Sub If ListBox1.ListIndex <> -1 Then ' التحقق من صحة البيانات If Not IsNumeric(TextBox1.Value) Then MsgBox "الكمية يجب أن تكون رقمًا." Exit Sub End If If ComboBox1.ListIndex = -1 Then MsgBox "يرجى اختيار المخزن الذي سيتم النقل منه." Exit Sub End If Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String Dim fromStore1 As Long, toStore2 As Long Dim itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long Dim foundItem As Boolean ' متغير للتحقق من وجود المنتج في المخزن invoiceNo = Val(TextBox2.Value) fromStore = ComboBox1.Value toStore = ComboBox2.Value itemCode = ComboBox3.Value Set wsSales = Worksheets("Log") Set wsStock = Worksheets("Inventaire") lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo And wsSales.Cells(i, "H").Value = itemCode Then quantity = wsSales.Cells(i, "J").Value newQuantity = Val(TextBox1.Value) quantityDiff = newQuantity - quantity ' تحديث الكمية في سجل المبيعات wsSales.Cells(i, "J").Value = newQuantity wsSales.Cells(i, "M").Value = Now() wsSales.Cells(i, "N").Value = Environ("Username") foundItem = False lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "B").Value = fromStore And wsStock.Cells(j, "C").Value = itemCode Then If wsStock.Cells(j, "G").Value - quantityDiff >= 0 Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value - quantityDiff foundItem = True Else MsgBox "الكمية الجديدة أقل من الكمية المتاحة في المخزن.", vbCritical Exit Sub ' الخروج من الـsub إذا كانت الكمية غير كافية End If ElseIf wsStock.Cells(j, "B").Value = toStore And wsStock.Cells(j, "C").Value = itemCode Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value + quantityDiff wsStock.Cells(j, "M").Value = Now() wsStock.Cells(j, "N").Value = Environ("Username") End If Next j If Not foundItem Then MsgBox "لم يتم العثور على المنتج في المخزن المصدر.", vbCritical Exit Sub End If End If Next i MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub Yahoo Mail: Search, Organize, Conquer المشكلة ماذالت قائمة بعد إضافة شرط اخر بكود الصنف Combobox 3 لقد عالج الكميه فى ورقة العمل Log ولم يعالج تحديث المخزون فى ورقة المخزون Inventaire

هل يمكن تعديل الكميه بناء على رقم الفاتورة وكود الصنف مع العلم عند تعديل على رقم الفاتورة يقوم بتحديث الكميه كل البيانات مع اختلاف كود الصنف وهذا خطاء لانة بيقوم على حسب الفاتورة و الفاتورة يووجد بيها اصناف كتيرة مختلفة وعند عملية التعديل كل كميات الفاتورة بتبقى معدله مع العلم أن كود الصنف Combobox 3 ومدرجه فى الخليه H Private Sub CommandButton2_Click() ' التحقق من وجود ورقة العمل "Transferts" If Not WorksheetExists("Log") Then MsgBox "غير موجودة" & " " & "Transferts" & " ورقة العمل", vbCritical, "خطأ" Exit Sub End If ' التحقق من القيم الفارغة If ListBox1.ListIndex = -1 Or (ComboBox3.Value = "" And Me.TextBox1.Value = "") Then Exit Sub If ListBox1.ListIndex <> -1 Then ' التحقق من صحة البيانات If Not IsNumeric(TextBox1.Value) Then MsgBox "الكمية يجب أن تكون رقمًا." Exit Sub End If If ComboBox1.ListIndex = -1 Then MsgBox "يرجى اختيار المخزن الذي سيتم النقل منه." Exit Sub End If Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String Dim fromStore1 As Long, toStore2 As Long Dim itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long invoiceNo = Val(TextBox2.Value) fromStore = ComboBox1.Value toStore = ComboBox2.Value fromStore1 = Val(stocktr.Value) toStore2 = Val(stocktrr.Value) Set wsSales = Worksheets("Log") Set wsStock = Worksheets("Inventaire") lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then quantity = wsSales.Cells(i, "J").Value ' الكمية الأصلية newQuantity = Val(TextBox1.Value) ' الكمية المعدلة quantityDiff = newQuantity - quantity ' الفرق بين الكمية الأصلية والمعدلة ' تعديل الكمية في سجل المبيعات wsSales.Cells(i, "J").Value = newQuantity wsSales.Cells(i, "M").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "N").Value = Environ("Username") ' اسم المستخدم ' تحديث المخزون بناءً على الفرق في الكمية lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "B").Value = fromStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value - quantityDiff ' إضافة أو طرح الفرق من المخزن الأصلي ElseIf wsStock.Cells(j, "B").Value = toStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value + quantityDiff ' خصم الفرق من المخزن الآخر wsStock.Cells(j, "M").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "N").Value = Environ("Username") ' اسم المستخدم End If Next j End If Next i MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" Else MsgBox "المرجوا تحديد الصف المراد تعديله", vbCritical, "" End If end sub برنامج امين المخزن2022.xlsm

اشكرك ا/ محمد هشام انك جعلت من وقتك لحل مشاكلنا التى تواجهنا فى معادلة vba excel اسأل الله أن يجعله في ميزان حسناتكم يارب العالمين

' تحديث المخزون بناءً على الفرق في الكمية lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "B").Value = fromStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value + quantityDiff ' إضافة أو طرح الفرق من المخزن الأصلي ElseIf wsStock.Cells(j, "B").Value = toStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value - quantityDiff ' خصم الفرق من المخزن الآخر wsStock.Cells(j, "M").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "N").Value = Environ("Username") ' اسم المستخدم End If Next j End If Next i 'تم تعديلة الى العكس السالب والموجب' ' تحديث المخزون بناءً على الفرق في الكمية lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "B").Value = fromStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value - quantityDiff ' إضافة أو طرح الفرق من المخزن الأصلي ElseIf wsStock.Cells(j, "B").Value = toStore Then wsStock.Cells(j, "G").Value = wsStock.Cells(j, "G").Value + quantityDiff ' خصم الفرق من المخزن الآخر wsStock.Cells(j, "M").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "N").Value = Environ("Username") ' اسم المستخدم End If Next j End If Next i تم تعديلة الى العكس السالب والموجب' لتنجح الفكرة شكرا ا/محمد هشام على المجهود الرائع

احسنت ا/ محمد هشام ولاكن بالنسبة لتعديل كمية الصنف وارجاع الكمية المتبقية الى المخزن وخصمها من المخزن الاخر لو افترضنا ان كود الصنف 100 بمخزن 1 ورصيده 55 كود الصنف 100 بمخزن 2 ورصيده 50 لو افترضنا اننا تم صرف برقم سريال 23 كود صنف 100 كمية 5 ك من مخزن 1 الى مخزن 2 وتم تعديل الكمية الى 2 ك المفروض يقوم بأرجاع الكمية المتبقية 3 الى مخزن 1 ليكون 58 ومخزن 2 ليكون 47 ولاكن الذى يتحقق العكس فأنة يقوم بخصم واضافة الكمية 2 ك الى المخزنين ليكون مخزن 1 رصيده 57 بدل 58 ومخزن 2 رصيده 48 بدل 47 هل يوجد طريقة تقوم بخصم واضافة الكمية المرحلة بدل الكمية المعدلة برنامج امين المخزن2022.xlsm

الرجاء النظرة على الشيت وتعديل عليها اذا احتاجت تحسينات بخصوص او يوجد تكرارات ويمكن دمجها Private Sub UserForm_Initialize() Set f = Sheets("Inventaire") OneRng = f.Range("A2:G" & f.[A65000].End(xlUp).Row).Value rng = UBound(OneRng, 2) ' تنسيق عمود اسم الصنف For i = 1 To UBound(OneRng): OneRng(i, 3) = OneRng(i, 3): Next i ' 4اسم المخزن rCrit1 = 1 'كود rCrit2 = 3 Set d = CreateObject("Scripting.Dictionary") d("*") = "" For i = LBound(OneRng) To UBound(OneRng) d(OneRng(i, rCrit1)) = "" Next i rw = d.Keys ' Sort Combobox 1 Colmuns "اسم المخزن" (5) tri rw, LBound(rw), UBound(rw) Me.ComboBox5.List = rw: Me.ComboBox5.ListIndex = 0 Set d = CreateObject("Scripting.Dictionary") d("*") = "" For i = LBound(OneRng) To UBound(OneRng) d(OneRng(i, rCrit2)) = "" Next i rw = d.Keys Me.ComboBox3.List = rw: Me.ComboBox3.ListIndex = 0 ' Me.ComboBox4.List = Me.ComboBox3.ListIndex ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set f = Sheets("Inventaire") OneRng = f.Range("B2:G" & f.[B65000].End(xlUp).Row).Value rng = UBound(OneRng, 2) ' تنسيق عمود اسم الصنف For i = 1 To UBound(OneRng): OneRng(i, 3) = OneRng(i, 3): Next i ' 4اسم المخزن rCrit3 = 1 'كود rCrit2 = 2 Set d = CreateObject("Scripting.Dictionary") d("*") = "" For i = LBound(OneRng) To UBound(OneRng) d(OneRng(i, rCrit3)) = "" Next i rw = d.Keys ' Sort Combobox 1 Colmuns "اسم المخزن" (5) tri rw, LBound(rw), UBound(rw) Me.ComboBox1.List = rw: Me.ComboBox1.ListIndex = 0 Set d = CreateObject("Scripting.Dictionary") d("*") = "" For i = LBound(OneRng) To UBound(OneRng) d(OneRng(i, rCrit2)) = "" Next i rw = d.Keys Me.ComboBox3.List = rw: Me.ComboBox3.ListIndex = 0 ' Me.ComboBox4.List = Me.ComboBox3.ListIndex ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim ws As Worksheet Dim lr As Integer Set ws = Sheets("Log") Me.TextBox5.Value = Format(Date, "dd/mm/yyyy") lr = ws.Cells(Rows.Count, 1).End(xlUp).Row ' NoCommande = Format(Val(Ws.Cells(Lr, 1)) + 1, "00 00") TextBox2 = Format(Val(ws.Cells(lr, 1)) + 1) ' Label24 = " تم التسجيل بواسطة المستخدم " & Sheet5.Range("A" & Rows.Count).End(xlUp) & " بتاريخ " & Sheet5.Range("b" & Rows.Count).End(xlUp) Dim lastRow As Long Set ws = Worksheets("Inventaire") ' ابحث عن الصف الأخير الذي يحتوي على البيانات في العمودين B وC lastRow = ws.Cells(Rows.Count, "D").End(xlUp).Row ' قم بتعبئة ComboBox3 بقيم فريدة من العمود B ' قم بملء ComboBox4 بقيم فريدة من العمود C For i = 2 To lastRow If ws.Cells(i, "D").Value <> ws.Cells(i - 1, "D").Value Then ComboBox4.AddItem ws.Cells(i, "D").Value End If Next i 'فرز ComboBox4 (تصاعدي) ComboBox4.ListIndex = -1 'إعادة تعيين الاختيار For i = 0 To ComboBox4.ListCount - 2 For j = i + 1 To ComboBox4.ListCount - 1 If ComboBox4.List(i) > ComboBox4.List(j) Then temp = ComboBox4.List(i) ComboBox4.List(i) = ComboBox4.List(j) ComboBox4.List(j) = temp End If Next j Next i '' ... كود الفرز 'For i = 2 To lastRow ' If ws.Cells(i, "C").Value <> ws.Cells(i - 1, "C").Value Then ' ComboBox4.AddItem ws.Cells(i, "C").Value ' End If 'Next i Me.ComboBox5 = "*" CancelOperation = False End Sub برنامج امين المخزن.xlsm

Cells(lastRow, 8).NumberFormat = "#,##0" ' تنسيق عزرا انا اتعمدت أن أكرر العمود لتنسيق قيمة الكميه فعزرا لانى اخطاءت فى كتابة تكرار الكود فى العمود ٨ احسنت ا/ محمد هشام هل ترى أن الكود يعمل بكفأئة ام يحتاج إلى تطوير أعمق واكثر نريد أن استفادة من خبراتك إذا تفضلت فى مجال cod vba

مقدمة الغرض: يقوم الكود بتحويل كميات الأصناف بين المخازن المختلفة بناءً على بيانات موجودة في جدول Excel بالمخزون "Inventaire" الفورم يحتوى على userform textbox and Combobox and listbox هذا الكود في VBA مخصص لإدارة عمليات نقل المنتجات بين مخازن مختلفة في جدول بيانات إكسيل. يقوم بتحديث كميات المنتجات في المخازن المصدر والهدف، ويسجل تفاصيل عملية النقل في ورقة عمل أخرى. وهى"Log" شرح خطوة بخطوة تعريف المتغيرات: يتم تعريف مجموعة من المتغيرات لتخزين البيانات المختلفة التي ستستخدمها أثناء عملية التحويل مثل: lastRow: لتحديد آخر صف في ورقة المخزون. itemData: وهو قاموس لتخزين بيانات الأصناف بشكل سريع وفعال. itemCode, quantity, sourceKey, targetKey: لتخزين معلومات عن الصنف والكمية والمخازن المصدر والهدف. ملء القاموس: يتم ملء القاموس itemData ببيانات الأصناف من ورقة المخزون. يتم إنشاء مفتاح فريد لكل صنف ومخزن لسهولة الوصول إليه. التكرار على عناصر ListBox1: يتم التكرار على العناصر الموجودة في ListBox1 والتي تمثل الأصناف التي سيتم تحويلها. التحققات: التحقق من وجود الصنف في قائمة التحويل: يتم التأكد من أن الصنف المراد تحويله موجود بالفعل في قائمة التحويل. التحقق من صحة البيانات: يتم التأكد من أن الكمية المراد تحويلها موجبة. التحقق من وجود الصنف في المخازن: يتم التأكد من وجود الصنف في كلا المخزنين المصدر والهدف. التحقق من كافية الكمية: يتم التأكد من أن الكمية المتاحة في المخزن المصدر كافية للعملية. التحقق من الكمية المتاحة: تم إضافة شرط للتحقق من أن الكمية المراد تحويلها لا تتجاوز الكمية المتاحة في المخزن المصدر. معالجة حالة عدم وجود المخزن الهدف: إذا لم يوجد المخزن الهدف، يمكنك إعطاء المستخدم خيار إنشاء المخزن الجديد أو إلغاء العملية. التحقق من وجود بيانات في ListBox1: للتأكد من وجود أصناف يتم تحويلها. تحديد آخر صف في ورقة المخزون: لتحديد نطاق البحث عن الأصناف. التكرار على عناصر ListBox1: لكل صنف، يتم البحث في ورقة المخزون عن الصفوف التي تطابق كود الصنف والمخزن. تحديث الكميات: يتم زيادة أو نقصان الكمية في المخزن المستهدف والمخزن المصدر على الترتيب. تحديث الكميات: يتم تحديث كميات الصنف في المخازن المصدر والهدف وفقًا للكمية المحولة. تسجيل التغيير: يتم تسجيل تفاصيل عملية التحويل في جدول السجل (ورقة "Log"). معالجة الأخطاء: يتم استخدام كتلة On Error GoTo لمعالجة أي أخطاء قد تحدث أثناء عملية التحويل وتسجيلها في ملف سجل. الوظائف المساعدة IsInList: هذه الوظيفة تستخدم للتحقق من وجود قيمة معينة في قائمة. UpdateInventory: هذه الوظيفة تستخدم لتحديث كميات المخزون في جدول البيانات. LogChange: هذه الوظيفة تستخدم لتسجيل تفاصيل عملية التحويل في جدول السجل. الميزات الرئيسية للكود مرونة: يمكن تخصيص الكود بسهولة لتلبية احتياجات مختلفة. كفاءة: يستخدم القاموس لتسريع عملية الوصول إلى البيانات. معالجة الأخطاء: يتضمن آلية لمعالجة الأخطاء وتسجيلها. واجهة مستخدم: يوفر واجهة مستخدم بسيطة لتسهيل عملية التحويل. هذا شرح كود عملية التحويل كمية صنف بين المخازن فهل الكود جيدا ام يريد اضافات علية Sub TransferQuantities() On Error GoTo ErrHandler ' تعريف المتغيرات Dim lastRow As Long Dim itemData As Object Set itemData = CreateObject("Scripting.Dictionary") ' تحديد آخر صف في ورقة المخزون (افتراضًا "Inventaire") With Sheets("Inventaire") lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row End With ' ملء قاموس ببيانات الأصناف Dim i As Long For i = 2 To lastRow Dim key As String key = .Cells(i, 3).value & "_" & .Cells(i, 2).value ' مفتاح فريد: كود الصنف + اسم المخزن itemData.Add key, i ' تخزين رقم الصف المقابل للمفتاح Next i Dim itemCode As Long Dim quantityToTransfer As Long Dim sourceKey As String Dim targetKey As String ' التكرار على عناصر ListBox1 For i = 0 To ListBox1.ListCount - 1 itemCode = Val(ListBox1.List(i, 0)) itemName = Val(ListBox1.List(i, 1)) quantity = Val(ListBox1.List(i, 2)) sourceKey = itemCode & "_" & Me.ComboBox1.value targetKey = itemCode & "_" & Me.ComboBox2.value If CancelOperation Then Exit For ' الحصول على التاريخ الحالي Dim currentDate As Date currentDate = Date ' التحقق من التاريخ If TextBox5.Value > currentDate Then MsgBox "التاريخ الذي أدخلته مستقبلي. يرجى إدخال تاريخ صحيح.", vbCritical Exit Sub End If ' التحقق من وجود الصنف في قائمة التحويل If Not IsInList(itemCode, ListBox1) Then MsgBox "الصنف " & itemCode & " غير موجود في قائمة التحويل.", vbCritical Exit Sub End If ' التحقق من صحة البيانات If quantityToTransfer <= 0 Then MsgBox "الكمية يجب أن تكون موجبة.", vbCritical Exit Sub End If ' التحقق من وجود الصنف في المخازن المصدر If Not itemData.Exists(sourceKey) Then MsgBox "الصنف " & itemCode & " غير موجود في المخزن المصدر " & Me.ComboBox1.value, vbCritical Exit Sub End If If Not itemData.Exists(targetKey) Then MsgBox "الصنف " & itemCode & " غير موجود في المخزن الهدف " & Me.ComboBox2.value, vbCritical Exit Sub End If ' التحقق من الكمية المتاحة في المخزن المصدر If fa.Cells(itemData(sourceKey), 7).value < quantityToTransfer Then MsgBox "الكمية المتاحة في المخزن المصدر غير كافية.", vbCritical Exit Sub End If ' تحديث الكميات On Error GoTo HandleError fa.Cells(itemData(sourceKey), 7).value = fa.Cells(itemData(sourceKey), 7).value - quantityToTransfer fa.Cells(itemData(targetKey), 7).value = fa.Cells(itemData(targetKey), 7).value + quantityToTransfer On Error GoTo 0 ' تسجيل التغيير With Sheets("Log") lastRowLog = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 .Cells(lastRowLog, 1) = TextBox2.value ' رقم الفاتورة .Cells(lastRowLog, 2) = TextBox5.value ' التاريخ .Cells(lastRowLog, 3) = "تم تحويل " & " من مخزن " & Me.ComboBox1.Value & " إلى مخزن " & Me.ComboBox2.Value .Cells(lastRowLog, 4) = Me.ComboBox1.value .Cells(lastRowLog, 5) = Me.ComboBox2.value .Cells(lastRowLog, 6) = itemCode .Cells(lastRowLog, 7) = itemName .Cells(lastRowLog, 8) = quantity .Cells(lastRowLog, 8) = quantity .Cells(lastRowLog, 9) = Environ("Username") End With Next i Dim answer As VbMsgBoxResult answer = MsgBox("هل أنت متأكد من تنفيذ عملية النقل؟", vbYesNo, "تأكيد") If answer = vbYes Then ' تنفيذ عملية النقل End If MsgBox "تمت عملية التحويل بنجاح. تم تسجيل التغييرات.", vbInformation Exit Sub ' تسجيل الخطأ في ملف سجل ErrHandler: Dim errorLog As String errorLog = "وقت الحدوث: " & Now & vbNewLine & _ "الخطأ: " & Err.Description & vbNewLine & _ "رقم السطر: " & Erl & vbNewLine & _ "الإجراء: " & Err.Source & vbNewLine & _ "الوظيفة: " & CurrentProcedure & vbNewLine & _ "القيم: itemCode=" & itemCode & ", quantity=" & quantity & ", sourceKey=" & sourceKey & ", targetKey=" & targetKey Open "ErrorLog.txt" For Append As #1 Print #1, errorLog Close #1 MsgBox "حدث خطأ أثناء عملية التحويل. يرجى التحقق من البيانات والمحاولة مرة أخرى.", vbCritical End Sub Private Sub UserForm_Initialize() ' ... (تهيئة عناصر UserForm) CancelOperation = False End Sub Private Sub cmdCancel_Click() CancelOperation = True Me.Hide End Sub '' وظيفة للتحقق من وجود الصنف في المخزن Function IsInList(itemValue As Variant, myList As Object) As Boolean Dim i As Long For i = 0 To myList.ListCount - 1 If myList.List(i, 0) = itemValue Then IsInList = True Exit Function End If Next i IsInList = False End Function Function IsItemInInventory(itemCode As Long, warehouseName As String) As Boolean ' التحقق من وجود الصنف في قائمة التحويل If Not IsInList(itemCode, ListBox1) Then MsgBox "الصنف " & itemCode & " غير موجود في قائمة التحويل.", vbCritical Exit Function End If End Function

تم ايجاد المشكلة بحمدلله الخاص بتعديل الكمية وارجاعها للمخزنين سواء خصم اوزيادة فى احداهما يوجد كودين Private Sub CommandButton2_Click() ' ... rest of your code ... Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String, itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long 'رقم الفاتورة invoiceNo = Val(TextBox2.Value) ' ComboBox1 المخزون الاول fromStore = ComboBox1.Value ' ComboBox2 المخزون الثانى toStore = ComboBox2.Value ' ComboBox1 رصيد المخزون الاول fromStore1 = stocktr.Value ' ComboBox2 رصيد المخزون الثانى toStore2 = stocktrr.Value 'شيت مبيعات Set wsSales = Worksheets("Transferts") 'شيت المخزون Set wsStock = Worksheets("Inventaire") 'ابحث عن الفاتورة في ورقة المبيعات lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) ' احسب فرق الكمية quantity = wsSales.Cells(i, "H").Value quantityDiff = newQuantity + quantity ' قم بتحديث الكمية في ورقة المبيعات wsSales.Cells(i, "H").Value = newQuantity wsSales.Cells(i, "k").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "l").Value = Environ("Username") ' اسم المستخدم End If Next i ' ابحث عن الفاتورة في ورقة المخزون lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock If wsStock.Cells(j, "A").Value = fromStore Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) quantity = wsStock.Cells(j, "D").Value quantityDiff = newQuantity - quantity ' قم بتحديث الكمية في ورقة المبيعات wsStock.Cells(j, "D").Value = newQuantity + fromStore1 ' تحديث الكميات في المخزون ' ... (نفس الكود السابق لإرجاع الكميات) ElseIf wsStock.Cells(j, "A").Value = toStore Then ' احصل على الكمية الجديدة من المستخدم (مثال: عن طريق TextBox) newQuantity = Val(TextBox1.Value) ' احسب فرق الكمية quantity = wsStock.Cells(j, "D").Value quantityDiff = newQuantity + quantity ' قم بتحديث الكمية في ورقة المبيعات wsStock.Cells(j, "D").Value = toStore2 - newQuantity wsStock.Cells(j, "J").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "K").Value = Environ("Username") ' اسم المستخدم End If Next j MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub Private Sub CommandButton2_Click() Dim wsSales As Worksheet, wsStock As Worksheet Dim lastRowSales As Long, lastRowStock As Long Dim i As Long, j As Long Dim invoiceNo As Long, fromStore As String, toStore As String, itemCode As String, quantity As Long, newQuantity As Long Dim quantityDiff As Long invoiceNo = Val(TextBox2.Value) ' ComboBox1 المخزون الاول fromStore = ComboBox1.Value ' ComboBox1 المخزون الاول toStore = ComboBox2.Value ' ComboBox1 قيمة المخزون الاول fromStore1 = stocktr.Value ' ComboBox2 قيمة المخزون الثانى toStore2 = stocktrr.Value Set wsSales = Worksheets("Transferts") Set wsStock = Worksheets("Inventaire") lastRowSales = wsSales.Cells(wsSales.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRowSales If wsSales.Cells(i, "A").Value = invoiceNo Then newQuantity = Val(TextBox1.Value) quantity = wsSales.Cells(i, "H").Value quantityDiff = newQuantity + quantity wsSales.Cells(i, "H").Value = newQuantity wsSales.Cells(i, "k").Value = Now() ' تاريخ التعديل wsSales.Cells(i, "l").Value = Environ("Username") ' اسم المستخدم End If Next i lastRowStock = wsStock.Cells(wsStock.Rows.Count, "A").End(xlUp).Row For j = 2 To lastRowStock quantity = wsStock.Cells(j, "D").Value If wsStock.Cells(j, "A").Value = fromStore Then wsStock.Cells(j, "D").Value = newQuantity + fromStore1 ElseIf wsStock.Cells(j, "A").Value = toStore Then wsStock.Cells(j, "D").Value = toStore2 - newQuantity ' تم التعديل هنا wsStock.Cells(j, "J").Value = Now() ' تاريخ التعديل wsStock.Cells(j, "K").Value = Environ("Username") ' اسم المستخدم End If Next j MsgBox "تم تعديل الفاتورة وإرجاع الكميات بنجاح" End Sub امين مخزن4.xlsm

احسنت استاذنا / محمد هشام. احسنت استاذنا / AbuuAhmed.

هذا هوالملف الخاص بالتعديل يوجد به مشكلة تحديث ارجاع كمية الى المخزن المحول منه فعال اما ارجاع الكميه من المخزن المحول الية غير مظبوط مثال شيت المخزون Set wsStock = Worksheets("Inventaire") مخزن1 الكمية المفترض 92 مخزن2 الكمية المفترض 75 والكمية المسترجعة من شيت المبيعات Set wsStock = Worksheets("Transferts") الكمية هى 5 الى شيت المخزون Set wsStock = Worksheets("Inventaire") بعد تحديث المخزون يكون مخزن1 الكمية المفترض 97 مخزن2 الكمية المفترض 70 ولاكن النتيجة فى شيت المخزون غير كدة بعد تحديث المخزون يكون مخزن1 الكمية المفترض 97 مخزن2 الكمية المفترض 80 تجد المشكلة فى الكمية المسترجعة فى مخزن2 تكون 70 بدل ان تزيد الكمية 5 لتكون 80 من اصل الكمية 75 امين مخزن3.xlsm