مشكلة فى تنسيق التاريخ او اضافة المخزون

[mahmoud nasr alhasany]

السلام عليكم ورحمة الله وبركاته

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

المشكلة فى فورم userform4

المشكلة فى التاريخ    selectedDate = CDate(TextBox15.Value) فعندما يتوافق كود الصنف والمخزن وصلاحية المنتج معا يتم اضافة الكمية لهذ الصنف اذا كانت التاريخ متوافق ولاكن لو كان يوجد صلاحية تاريخ جديد يتم اضافة سطر جديد كود صنف ومخزن وكمية وصلاحية فوجد ان الكمية تضاف للمخزن اذا كانت الصلاحية متوافقة مثل 01/01/2024 ولاكن لو كانت صلاحية اخرى مثل اى تاريخ 02/01/2024 او 03/01/2024 والخ يتم اضافة سطر جديد مع العلم ان التاريخ لهذا الصنف والمخزن موجود والمفروض يتم اضتافة الكمية للمخزون وليس اضافة سطر جديد

 

 

 

 

Private Sub CommandButton4_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim item As String, fromStore As String
    Dim selectedDate As Date ' تعريف المتغير كـ Date مباشرة
    Dim quantity As Long
    Dim foundRow As Long

    Set ws = ThisWorkbook.Sheets("sheet1")

    ' تحسين: استخدام Find بدلاً من قراءة المصفوفة بالكامل
    With ws.columns("A") ' البحث في العمود A فقط
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
        item = ComboBox4.Value
        fromStore = ComboBox2.Value
        selectedDate = CDate(TextBox15.Value) ' لا داعي لـ Format هنا، CDate يتعامل مع التواريخ بشكل جيد

        quantity = CLng(TextBox8.Value)

        If quantity <= 0 Then
            MsgBox "الكمية المحولة يجب أن تكون أكبر من الصفر", vbExclamation
            Exit Sub
        End If

        ' البحث عن التطابق
        Set foundCell = .Find(What:=item, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

        If Not foundCell Is Nothing Then
            foundRow = foundCell.row
            ' التحقق من تطابق باقي الشروط في نفس الصف
            If ws.Cells(foundRow, 3).Value = fromStore And ws.Cells(foundRow, 7).Value = selectedDate Then
                ws.Cells(foundRow, 6).Value = ws.Cells(foundRow, 6).Value + quantity 'تحديث مباشر للكمية المخزون في الخلية على حسب نوع المخزن وكود الصنف و مطابقة التاريخ معا '
            Exit Sub 'الخروج من الإجراء بعد التحديث
            End If
        End If
    End With

    ' إذا لم يتم العثور على تطابق المخزن وكود الصنف بسبب تاريخ صلاحية جديدة، يتم إضافة صف جديد
    lastRow = lastRow + 1
    With ws.Rows(lastRow) ' استخدام With لتسهيل الكتابة
        .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 = selectedDate
    End With

' اضافة البيانات سواء كانت تحويلات او شراء الى ورقة تسجيل البيانات
Dim wss As Worksheet
Dim lastRow1 As Long
Dim serialNumber As Long
    serialNumber = 1
    ' تحديد ورقة العمل (قم بتغيير "Sheet1" إذا لزم الأمر)
    Set wss = ThisWorkbook.Sheets("تسجيل البيانات")

    ' العثور على آخر صف يحتوي على بيانات في العمود A
    lastRow1 = wss.Cells(Rows.Count, "A").End(xlUp).row
     serialNumber = lastRow1 '+ 1

    ' كتابة القيم في الصف التالي
    lastRow1 = lastRow1 + 1
    wss.Cells(lastRow1, "A").Value = TextBox5
    wss.Cells(lastRow1, "B").Value = TextBox6
    wss.Cells(lastRow1, "C").Value = ("شراء")
    wss.Cells(lastRow1, "D").Value = ComboBox4.Value
    wss.Cells(lastRow1, "E").Value = ComboBox3.Value
    wss.Cells(lastRow1, "F").Value = ComboBox2.Value
    wss.Cells(lastRow1, "g").Value = ComboBox1.Value
    wss.Cells(lastRow1, "h").Value = TextBox7.Value
    wss.Cells(lastRow1, "i").Value = TextBox1.Value
    wss.Cells(lastRow1, "j").Value = TextBox8.Value
    wss.Cells(lastRow1, "k").Value = TextBox9.Value
    wss.Cells(lastRow1, "l").Value = TextBox10.Value
    wss.Cells(lastRow1, "m").Value = TextBox11.Value
    wss.Cells(lastRow1, "n").Value = TextBox12.Value
    wss.Cells(lastRow1, "o").Value = TextBox15.Value
    wss.Cells(lastRow1, "p").Value = Format(Now, "DDDD MM/DD/YYYY HH:MM:SS AM/PM") 'dddd, dd mm, yyyy hh:mm:ss AM/PM

End Sub

 

stock.xlsm

تم تعديل الأربعاء at 08:57 بواسطه mahmoud nasr alhasany

[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

 

تم تعديل الخميس at 07:52 بواسطه mahmoud nasr alhasany