mahmoud nasr alhasany

تم الحل  ولاكن بكود مختلف اخر
Sub UpdateStock() Dim ws As Worksheet Dim lastRow As Long, foundRow As Long Dim item As String, fromStore As String, selectedDate As Date Dim quantity As Long Dim foundMatch As Boolean Set ws = ThisWorkbook.Sheets("Sheet1") item = ComboBox4.Value fromStore = ComboBox2.Value selectedDate = CDate(TextBox15.Value) quantity = CLng(TextBox8.Value) If quantity <= 0 Then MsgBox "الكمية المحولة يجب أن تكون أكبر من الصفر", vbExclamation Exit Sub End If foundMatch = False ' Flag to indicate if a match is found With ws.Range("A2:G" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) Set foundCell = .Find(What:=item, LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundCell Is Nothing Then firstAddress = foundCell.Address Do If ws.Cells(foundCell.Row, 3).Value = fromStore And _ ws.Cells(foundCell.Row, 7).Value = selectedDate Then ws.Cells(foundCell.Row, 6).Value = ws.Cells(foundCell.Row, 6).Value + quantity foundMatch = True Exit Do End If Set foundCell = .FindNext(After:=foundCell) Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress End If ' Add new row only if no exact match was found If Not foundMatch Then lastRow = ws.UsedRange.Rows.Count + 1 With ws.Rows(lastRow) .Cells(1).Value = item .Cells(2).Value = ComboBox3.Value .Cells(3).Value = fromStore .Cells(4).Value = TextBox7.Value .Cells(5).Value = TextBox1.Value .Cells(6).Value = TextBox8.Value .Cells(7).Value = TextBox15 End With MsgBox "تم إضافة صف جديد بنجاح", vbInformation ElseIf foundMatch Then MsgBox "تم تحديث الكمية في الصف الموجود", vbInformation End If End With End Sub Private Sub CommandButton4_Click() Call UpdateStock End Sub  

تم عمل المطلوب
قنم بوضع الاسم   فى الفورم 2     textbox3 ثم قم باختيار من لوحة المفاتيح الامر  F4 للانتقال بوضع الاسم الذى تم اختيارة فى listbox1 من خلال انتقال الاسهم من لوحة المفاتيح بعد الامر مباشرة F4  وعند اختيار الاسم المحدد  قم باختيار الامر  F2 للانتقال الى الفورم 1 وشكرا
شاشة عميل بحث(1).xlsm

Dim totalValue As Double Dim targetValue1 As Double Dim targetValue2 As Double ' Get values from TextBoxes totalValue = Val(TextBox10.Value) targetValue1 = Val(TextBox11.Value) targetValue2 = Val(TextBox12.Value) ' Check for feasibility If targetValue1 + targetValue2 <> totalValue Then MsgBox "Target values do not match total value.", vbCritical Exit Sub End If ' Initialize banknote counts Dim count200 As Integer: count200 = Val(TextBox1.Value) Dim count100 As Integer: count100 = Val(TextBox2.Value) Dim count50 As Integer: count50 = Val(TextBox3.Value) ' Create arrays to store distribution Dim group1(1 To 3) As Integer Dim group2(1 To 3) As Integer ' Random distribution loop Do ' Reset group values For i = 1 To 3 group1(i) = 0 group2(i) = 0 Next i ' Randomly assign 200 denomination banknotes Randomize For i = 1 To count200 If Rnd() < 0.5 Then group1(1) = group1(1) + 1 Else group2(1) = group2(1) + 1 End If Next ' Randomly assign 100 denomination banknotes Randomize For i = 1 To count100 If Rnd() < 0.5 Then group1(2) = group1(2) + 1 Else group2(2) = group2(2) + 1 End If Next ' Randomly assign 50 denomination banknotes Randomize For i = 1 To count50 If Rnd() < 0.5 Then group1(3) = group1(3) + 1 Else group2(3) = group2(3) + 1 End If Next ' Calculate the total value of each group Dim group1Total As Double: group1Total = group1(1) * 200 + group1(2) * 100 + group1(3) * 50 Dim group2Total As Double: group2Total = group2(1) * 200 + group2(2) * 100 + group2(3) * 50 Loop Until group1Total = targetValue1 And group2Total = targetValue2 ' Display the distribution in TextBoxes or other controls TextBox4.Value = group1(1) TextBox7.Value = group2(1) TextBox5.Value = group1(2) TextBox8.Value = group2(2) TextBox6.Value = group1(3) TextBox9.Value = group2(3) لقد وجدت الحل بحمدلله

وجدت الحل بحمدلله
Private Sub CheckBox1_Click() Dim arr() As Variant Dim i As Long, j As Long, temp As Variant Dim sortColumn As Integer Dim sortOrder As Boolean ' نسخ البيانات من ListBox إلى المصفوفة ReDim arr(ListBox1.ListCount - 1, ListBox1.ColumnCount - 1) For i = 0 To ListBox1.ListCount - 1 For j = 0 To ListBox1.ColumnCount - 1 arr(i, j) = ListBox1.List(i, j) Next j Next i ' تحديد عمود الفرز بناءً على ComboBox sortColumn = ComboBox1.ListIndex ' تحديد اتجاه الفرز بناءً على CheckBox sortOrder = CheckBox1.Value ' الفرز باستخدام Bubble Sort For i = LBound(arr) To UBound(arr) - 1 For j = i + 1 To UBound(arr) If sortOrder Then ' ترتيب تنازلي If IsNumeric(arr(i, sortColumn)) Or IsNumeric(arr(j, sortColumn)) Then If CDbl(arr(i, sortColumn)) > CDbl(arr(j, sortColumn)) Then ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If Else If UCase(arr(i, sortColumn)) > UCase(arr(j, sortColumn)) Then ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If End If Else ' ترتيب تصاعدي If IsNumeric(arr(i, sortColumn)) Or IsNumeric(arr(j, sortColumn)) Then If CDbl(arr(i, sortColumn)) < CDbl(arr(j, sortColumn)) Then ' تبادل السجلين ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If Else If UCase(arr(i, sortColumn)) < UCase(arr(j, sortColumn)) Then ' تبادل السجلين ' تبادل السجلين For k = LBound(arr, 2) To UBound(arr, 2) temp = arr(i, k) arr(i, k) = arr(j, k) arr(j, k) = temp Next k End If End If End If  

' تحديث المخزون بناءً على الفرق في الكمية 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 تم تعديلة الى العكس السالب والموجب'
لتنجح الفكرة شكرا ا/محمد هشام على المجهود الرائع
 

تم ايجاد المشكلة بحمدلله الخاص بتعديل الكمية وارجاعها للمخزنين سواء خصم اوزيادة فى احداهما
يوجد كودين
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

فاتورة خبوريه
من اعمال السيد/ ضاحى غريب
والسيد / عبدلله باقشير
 

تم حل المشكلة بواسطة منتدى اخر وذلك لانشغال بعض الاخوة فى الرد على الموضوع كان الله فى عونهما واحببت ان ارفق الملف للاستفادة
NEW EMPLOYEE TIME SHEET testing123.xls

الملف غير كامل
لايوجد فية Sheet7
form1.Hide
Sheet7.Range("R4").Value = Application.WorksheetFunction.VLookup(rngUser.Offset(0, -1).Value, Sheet1.Range("d2:d100"), 1, False)
Sheet7.Range("E4").Value = Date
Sheet7.Range("I4").Value = Application.WorksheetFunction.Text(Sheet7.Range("I4").Value, "dddd")
Sheet7.Range("M4").Value = Time
form2.Show
End If
 

On Error Resume Next Dim X As Worksheet Dim k As Integer Dim m As Date Dim n As Date ListBox1.Clear rng1 = CDate(TextBox9.Value) rng2 = CDate(TextBox10.Value) rng3 = ComboBox1.Text rng4 = ComboBox2.Text dfr = 0 For Each X In ThisWorkbook.Worksheets ss = X.Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To ss If X.Cells(i, 6) Like "*" & rng3 & "*" And X.Cells(i, 4) Like "*" & rng4 & "*" And X.Cells(i, 2) >= rng1 And X.Cells(i, 2) <= rng2 Then ListBox1.AddItem ListBox1.List(dfr, 0) = X.Cells(i, 1) ListBox1.List(dfr, 1) = Format(X.Cells(i, 2), "dd/mm/yyyy") ListBox1.List(dfr, 2) = X.Cells(i, 3) ListBox1.List(dfr, 3) = X.Cells(i, 4) ListBox1.List(dfr, 4) = X.Cells(i, 5) ListBox1.List(dfr, 5) = X.Cells(i, 6) ListBox1.List(dfr, 6) = X.Cells(i, 7) ListBox1.List(dfr, 7) = X.Cells(i, 8) ListBox1.List(dfr, 8) = X.Cells(i, 9) ListBox1.List(dfr, 9) = X.Cells(i, 10) ListBox1.List(dfr, 10) = X.Cells(i, 11) '.Value ListBox1.List(dfr, 11) = X.Cells(i, 12) '.Value dfr = dfr + 1 End If Next i Next X Call Main Call Sort  
شكرا جزيلا  ا/ محمد هشام لقد تم الحل ونسيت ان ارفقه