اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

husain alhammadi

بواسطه husain alhammadi
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

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

 

 

 

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

تم تعديل بواسطه husain alhammadi
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

تم تعديل بواسطه husain alhammadi
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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept