بطاقة الصنف
السلام عليكم و رحمة الله و بركاتة
ارجوا مساعدتي في اكمال الكود خاص ببطاقة الصنف
Private Sub CommandButton1_Click()
Dim v, x, y, wsItems As Worksheet, wsWared As Worksheet, wsSarf As Worksheet, sh As Worksheet, lr As Long
lr = [c10000].End(xlUp).Row
Sheets("ÈØÇÞÉ ÇáÕäÝ").Range("b12:i10000").ClearContents
Application.ScreenUpdating = False
Set wsItems = ThisWorkbook.Worksheets("ÈíÇäÇÊ ÇáÇÕäÇÝ")
Set wsWared = ThisWorkbook.Worksheets("ÊÞÑíÑÇáæÇÑÏ")
Set wsSarf = ThisWorkbook.Worksheets("ÊÞÑíÑÇáÕÑÝ")
Set sh = ThisWorkbook.Worksheets("ÈØÇÞÉ ÇáÕäÝ")
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
x = Application.Match(sh.Range("C8").Value, wsWared.Columns(1), 0)
If Not IsError(x) Then
sh.Cells(lr, 2).Resize(1, 2).Value = wsWared.Cells(x, 2).Resize(1, 2).Value
sh.Cells(lr, 4).Resize(1, 2).Value = wsWared.Cells(x, 8).Resize(1, 2).Value
End If
y = Application.Match(sh.Range("C8").Value, wsSarf.Columns(1), 0)
If Not IsError(y) Then
sh.Cells(lr, 6).Value = wsSarf.Cells(y, 3).Value
sh.Cells(lr, 7).Resize(1, 2).Value = wsSarf.Cells(y, 8).Resize(1, 2).Value
End If
Application.ScreenUpdating = True
End Sub
يعني فى الوارد يوجد صنف الشاي بتاريخ 20-12-2019 و 21-12-2019 و 22-12-2019 و الى اخره و كذلك فى الصرف تم صرف عدة مرات
و المطلوب هو من b9 الى I10000 بواسطة D9 الى D10000 تقريرالوارد يتم وضعها b9 الوارد في b12 بطاقة الصنف H9 و I9 تقريرالوارد في D12 و E12 بطاقة الصنف رقم الفاتورة C9 الوارد في C12 بطاقة الصنف
من b9 الى I10000 بواسطة D9 الى D10000 تقريرالصرف يتم وضعها b9 الصرف في b12 بطاقة الصنف H9 و I9 تقريرالصرف في G12 و H12 بطاقة الصنف رقم الفاتورة C9 الصرف في F12 بطاقة الصنف
على ان يتم مسح بيانات السابقة من البطاقة الصنف بمجرد تغيير الرقم في C8 بطاقة الصنف
و لكم مني جزيل الشكر