كود بطاقة الصنف

[husain alhammadi]

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

اخواني الخبراء هل يوجد خطا فى كود بطاقة الصنف

B11 تاريخ بد البرنامج و هو ثابت

I11 رصيد بد البرنامج و هو ثابت 0

I12 الى الشيت I1000 (=I11+D12-G12)

B11هو تاريخ الوارد و الصرف في حالة عدم وجود الصرف فى نفس يوم يترك فاضي 

Private Sub CommandButton1_Click()

    Dim a, b, v, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long, i As Long, k As Long

    Application.ScreenUpdating = False
        Set wsItems = ThisWorkbook.Worksheets("sheet4")
        Set wsWared = ThisWorkbook.Worksheets("sheet6")
        Set wsSarf = ThisWorkbook.Worksheets("sheet8")
        Set sh = ThisWorkbook.Worksheets("sheet9")
        
        sh.Range("A12:I" & Rows.Count).ClearContents
        lr = Application.Max(12, sh.Cells(Rows.Count, 3).End(xlUp).Row + 1)
        If sh.Range("C8").Value = "" Then Exit Sub
        
        v = Application.Match(sh.Range("C8").Value, wsItems.Columns(2), 0)
        If Not IsError(v) Then
            sh.Cells(8, 3).Resize(1, 4).Value = wsItems.Cells(v, 2).Resize(1, 4).Value
            sh.Range("I11").Value = wsItems.Cells(v, 6).Value
            sh.Range("B11").Value = DateSerial(Year(Date), 1, 1)
        End If
        
        k = 0
        a = wsWared.Range("A9:I" & wsWared.Cells(Rows.Count, 3).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 5)
        For i = LBound(a) To UBound(a)
            If a(i, 4) = sh.Range("C8").Value Then
                k = k + 1
                b(k, 1) = a(i, 1)
                b(k, 2) = a(i, 2)
                b(k, 3) = a(i, 3)
                b(k, 4) = a(i, 8)
                b(k, 5) = a(i, 9)
            End If
        Next i
        If k > 0 Then sh.Range("A" & lr).Resize(k, UBound(b, 2)).Value = b
        
        k = 0
        a = wsSarf.Range("A9:I" & wsSarf.Cells(Rows.Count, 3).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 3)
        For i = LBound(a) To UBound(a)
            If a(i, 4) = sh.Range("C8").Value Then
                k = k + 1
                b(k, 1) = a(i, 3)
                b(k, 2) = a(i, 8)
                b(k, 3) = a(i, 9)
            End If
        Next i
        If k > 0 Then sh.Range("F" & lr).Resize(k, UBound(b, 2)).Value = b
   Application.ScreenUpdating = True
End Sub

 

 

 

شاشة الدخول مع صلاحيات 4.xlsb

تم تعديل أكتوبر 24, 2023 بواسطه husain alhammadi

[husain alhammadi]

التاريخ	الوارد			الصرف			الرصيد
	رقم الفاتورة	الكمية	القيمة	رقم الفاتورة	الكمية	القيمة
2023/01/01							0
02/01/2023	100001	100	د.إِ.1500				90
03/01/2023				200001	10	د.إِ.1500	180
13/01/2023				200002	10	د.إِ.1500	270
23/01/2023				200003	10	د.إِ.1500	360
03/02/2023				200004	10	د.إِ.1500	350
13/02/2023				200005	10	د.إِ.1500	340
23/02/2023				200006	10	د.إِ.1500	340
02/04/2023	100002	100	د.إِ.1500				340
02/07/2023	100003	100	د.إِ.1500				340
02/10/2023	100004	100	د.إِ.1500				340

[husain alhammadi]

اقتباس

 

للرفع

[husain alhammadi]

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

اخواني الخبراء هل يوجد خطا فى كود بطاقة الصنف

B11 تاريخ بد البرنامج و هو ثابت

I11 رصيد بد البرنامج و هو ثابت 0

I12 الى الشيت I1000 (=I11+D12-G12)

B11هو تاريخ الوارد و الصرف في حالة عدم وجود الصرف فى نفس يوم يترك فاضي 

مشاركة السابقة نموذج للمطلوب

Private Sub CommandButton1_Click()

    Dim a, b, v, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long, i As Long, k As Long

    Application.ScreenUpdating = False
        Set wsItems = ThisWorkbook.Worksheets("sheet4")
        Set wsWared = ThisWorkbook.Worksheets("sheet6")
        Set wsSarf = ThisWorkbook.Worksheets("sheet8")
        Set sh = ThisWorkbook.Worksheets("sheet9")
        
        sh.Range("A12:I" & Rows.Count).ClearContents
        lr = Application.Max(12, sh.Cells(Rows.Count, 3).End(xlUp).Row + 1)
        If sh.Range("C8").Value = "" Then Exit Sub
        
        v = Application.Match(sh.Range("C8").Value, wsItems.Columns(2), 0)
        If Not IsError(v) Then
            sh.Cells(8, 3).Resize(1, 4).Value = wsItems.Cells(v, 2).Resize(1, 4).Value
            sh.Range("I11").Value = wsItems.Cells(v, 6).Value
            sh.Range("B11").Value = DateSerial(Year(Date), 1, 1)
        End If
        
        k = 0
        a = wsWared.Range("A9:I" & wsWared.Cells(Rows.Count, 3).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 5)
        For i = LBound(a) To UBound(a)
            If a(i, 4) = sh.Range("C8").Value Then
                k = k + 1
                b(k, 1) = a(i, 1)
                b(k, 2) = a(i, 2)
                b(k, 3) = a(i, 3)
                b(k, 4) = a(i, 8)
                b(k, 5) = a(i, 9)
            End If
        Next i
        If k > 0 Then sh.Range("A" & lr).Resize(k, UBound(b, 2)).Value = b
        
        k = 0
        a = wsSarf.Range("A9:I" & wsSarf.Cells(Rows.Count, 3).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 3)
        For i = LBound(a) To UBound(a)
            If a(i, 4) = sh.Range("C8").Value Then
                k = k + 1
                b(k, 1) = a(i, 3)
                b(k, 2) = a(i, 8)
                b(k, 3) = a(i, 9)
            End If
        Next i
        If k > 0 Then sh.Range("F" & lr).Resize(k, UBound(b, 2)).Value = b
   Application.ScreenUpdating = True
End Sub

 

برنامج المستودع.xlsb

تم تعديل أكتوبر 29, 2023 بواسطه husain alhammadi

[husain alhammadi]

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

     التاريخ                  الوارد                         الصرف                       الرصيد
                  رقم الفاتورة    الكمية القيمة رقم الفاتورة الكمية    القيمة
2023/01/01                                                                               0
02/01/2023    100001    100    د.إِ.1500                                      90
03/01/2023                                       200001    10    د.إِ.1500    180
13/01/2023                                       200002    10    د.إِ.1500    270
23/01/2023                                       200003    10    د.إِ.1500    360
03/02/2023                                       200004    10    د.إِ.1500    350
13/02/2023                                       200005    10    د.إِ.1500    340
23/02/2023                                       200006    10    د.إِ.1500    340
02/04/2023    100002    100    د.إِ.1500                                     340
02/07/2023    100003    100    د.إِ.1500                                     340
02/10/2023    100004    100    د.إِ.1500                                    340

هذا الشكل مطلوب فقط التاريخ الصرف

تم تعديل أكتوبر 30, 2023 بواسطه husain alhammadi