اذهب الي المحتوي
أوفيسنا

تجميع الكميات الواردة والمنصرفه اعتمادا على كود الصنف

ناصرالمصرى

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

 مشاركة

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

ناصرالمصرى

ناصرالمصرى

قام بنشر
قام بنشر (معدل)

الاحباب الكرام أحباب رسول الله " صلى الله عليه وسلم "

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

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

الورقة الاولى " أرشيف " ويتم ترحيل جميع الكميات الواردة والمنصرفة من الاصناف اليها على مدار الشهر 

الورقة الثانية " بيان تجميعى " والمطلوب فيها بإذن الله تعالى كود مهمته تجميع ونقل الكميات الواردة

من الاعمدة E   الى  I   اعتمادا  على عمود  كود الصنف بالعمود  E  بورقة ارشيف الى الاعمدة من B   الى F  بالورقة بيان تجميعى هذا أولا

مثال كمية واردة

كود رقم 1001 ورد كمية بتاريخ 2017/1/1 = 100

نفس كود الصنف ورد كمية بتاريخ 2017/1/12 = 1200 الناتج = 1300

أما ثانيا فهو تجميع ونقل الكميات المنصرفة

من الاعمدة M    الى Q  اعتمادت على  كود الصنف بالعمود  Q  بورقة ارشيف الى الاعمدة من  G  الى  K  بالورقة بيان تجميعى

مثال كمية منصرفة

كود رقم 1011 صُرفت كميات منه بتواريخ مختلفة 60 + 32 + 35 الناتج = 127

شاكر فضل حضراتكم وجزاكم الله خيرا

تجميع الكميات الواردة والمنصرفه على اساس كود الصنف.xlsb.rar

تم تعديل بواسطه ناصرالمصرى
رابط هذا التعليق
شارك
ابراهيم الحداد

ابراهيم الحداد

قام بنشر
قام بنشر

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

انسخ الكود التالى والصقه فى موديول

وخصص له زر 

Sub TransrerData()
Dim ws As Worksheet, sh As Worksheet
Dim LR As Long, LS As Long
Dim R As Integer, S As Integer, p As Integer, Cod As Byte, Cod2 As Byte
Dim Qty As Long, Qty2 As Long
Set ws = Sheets("ÇÑÔíÝ")
Set sh = Sheets("ÈíÇä ÊÌãíÚì")
sh.Range("B10:K100").ClearContents
Application.ScreenUpdating = False
LR = ws.Range("E" & Rows.Count).End(xlUp).Row
For R = 10 To LR
Cod = WorksheetFunction.CountIf(Range(ws.Cells(10, "E"), _
ws.Cells(R, "E")), ws.Cells(R, "E"))
If Cod = 1 Then
sh.Cells(R, "B") = ws.Cells(R, "E")
sh.Cells(R, "C") = ws.Cells(R, "F")
sh.Cells(R, "D") = ws.Cells(R, "G")
sh.Cells(R, "F") = ws.Cells(R, "I")
Qty = WorksheetFunction.SumIf(Range(ws.Cells(10, "E"), ws.Cells(LR, "E")), _
sh.Cells(R, "B"), Range(ws.Cells(10, "H"), ws.Cells(LR, "H")))
sh.Cells(R, "E") = Qty
End If
Next
LS = ws.Range("M" & Rows.Count).End(xlUp).Row
p = 9
For S = 10 To LS
Cod2 = WorksheetFunction.CountIf(Range(ws.Cells(10, "M"), _
ws.Cells(S, "M")), ws.Cells(S, "M"))
If Cod2 = 1 Then
p = p + 1
sh.Cells(p, "G") = ws.Cells(S, "M")
sh.Cells(p, "H") = ws.Cells(S, "N")
sh.Cells(p, "I") = ws.Cells(S, "O")
sh.Cells(p, "K") = ws.Cells(S, "Q")
Qty2 = WorksheetFunction.SumIf(Range(ws.Cells(10, "M"), ws.Cells(LS, "M")), _
sh.Cells(p, "G"), Range(ws.Cells(10, "P"), ws.Cells(LS, "P")))
sh.Cells(p, "J") = Qty2
End If
Next
Application.ScreenUpdating = True
End Sub

 

  • Like 2
رابط هذا التعليق
شارك
ناصرالمصرى

ناصرالمصرى

قام بنشر
  • الكاتب
قام بنشر

أستاذى الفاضل / زيزو العجوز 

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

بداية بارك الله فيكم وجزاكم الله خيرا  واعتذر للتأخير فى الرد لظروف طارئة

فى الحقيقة يعجز لسانى أمام هذا الجهد الكبير جعله الله تعالى فى موازيين حسناتكم

ارغب فى إضافتين هذا بعد إذن حضرتك الاضافة الاولى الا وهى الترقيم التلقائى بالورقة " بيان تجميعى"

اما الاضافة الاخرى بذات الورقة  فهى ترتيب الاكواد  كما هو بالمرفق التالى  **** شاكر فضل حضرتك وجزاكم الله خيرا

تجميع الكميات الواردة والمنصرفه على اساس كود الصنف+1111.rar

رابط هذا التعليق
شارك
ابو يوسف العلفي

ابو يوسف العلفي

قام بنشر
قام بنشر
في ٢٣‏/٢‏/٢٠١٧ at 02:55, زيزو العجوز said:

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

انسخ الكود التالى والصقه فى موديول

وخصص له زر 


Sub TransrerData()
Dim ws As Worksheet, sh As Worksheet
Dim LR As Long, LS As Long
Dim R As Integer, S As Integer, p As Integer, Cod As Byte, Cod2 As Byte
Dim Qty As Long, Qty2 As Long
Set ws = Sheets("ÇÑÔíÝ")
Set sh = Sheets("ÈíÇä ÊÌãíÚì")
sh.Range("B10:K100").ClearContents
Application.ScreenUpdating = False
LR = ws.Range("E" & Rows.Count).End(xlUp).Row
For R = 10 To LR
Cod = WorksheetFunction.CountIf(Range(ws.Cells(10, "E"), _
ws.Cells(R, "E")), ws.Cells(R, "E"))
If Cod = 1 Then
sh.Cells(R, "B") = ws.Cells(R, "E")
sh.Cells(R, "C") = ws.Cells(R, "F")
sh.Cells(R, "D") = ws.Cells(R, "G")
sh.Cells(R, "F") = ws.Cells(R, "I")
Qty = WorksheetFunction.SumIf(Range(ws.Cells(10, "E"), ws.Cells(LR, "E")), _
sh.Cells(R, "B"), Range(ws.Cells(10, "H"), ws.Cells(LR, "H")))
sh.Cells(R, "E") = Qty
End If
Next
LS = ws.Range("M" & Rows.Count).End(xlUp).Row
p = 9
For S = 10 To LS
Cod2 = WorksheetFunction.CountIf(Range(ws.Cells(10, "M"), _
ws.Cells(S, "M")), ws.Cells(S, "M"))
If Cod2 = 1 Then
p = p + 1
sh.Cells(p, "G") = ws.Cells(S, "M")
sh.Cells(p, "H") = ws.Cells(S, "N")
sh.Cells(p, "I") = ws.Cells(S, "O")
sh.Cells(p, "K") = ws.Cells(S, "Q")
Qty2 = WorksheetFunction.SumIf(Range(ws.Cells(10, "M"), ws.Cells(LS, "M")), _
sh.Cells(p, "G"), Range(ws.Cells(10, "P"), ws.Cells(LS, "P")))
sh.Cells(p, "J") = Qty2
End If
Next
Application.ScreenUpdating = True
End Sub

 

 

في ٢٣‏/٢‏/٢٠١٧ at 02:55, زيزو العجوز said:

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

انسخ الكود التالى والصقه فى موديول

وخصص له زر 


Sub TransrerData()
Dim ws As Worksheet, sh As Worksheet
Dim LR As Long, LS As Long
Dim R As Integer, S As Integer, p As Integer, Cod As Byte, Cod2 As Byte
Dim Qty As Long, Qty2 As Long
Set ws = Sheets("ÇÑÔíÝ")
Set sh = Sheets("ÈíÇä ÊÌãíÚì")
sh.Range("B10:K100").ClearContents
Application.ScreenUpdating = False
LR = ws.Range("E" & Rows.Count).End(xlUp).Row
For R = 10 To LR
Cod = WorksheetFunction.CountIf(Range(ws.Cells(10, "E"), _
ws.Cells(R, "E")), ws.Cells(R, "E"))
If Cod = 1 Then
sh.Cells(R, "B") = ws.Cells(R, "E")
sh.Cells(R, "C") = ws.Cells(R, "F")
sh.Cells(R, "D") = ws.Cells(R, "G")
sh.Cells(R, "F") = ws.Cells(R, "I")
Qty = WorksheetFunction.SumIf(Range(ws.Cells(10, "E"), ws.Cells(LR, "E")), _
sh.Cells(R, "B"), Range(ws.Cells(10, "H"), ws.Cells(LR, "H")))
sh.Cells(R, "E") = Qty
End If
Next
LS = ws.Range("M" & Rows.Count).End(xlUp).Row
p = 9
For S = 10 To LS
Cod2 = WorksheetFunction.CountIf(Range(ws.Cells(10, "M"), _
ws.Cells(S, "M")), ws.Cells(S, "M"))
If Cod2 = 1 Then
p = p + 1
sh.Cells(p, "G") = ws.Cells(S, "M")
sh.Cells(p, "H") = ws.Cells(S, "N")
sh.Cells(p, "I") = ws.Cells(S, "O")
sh.Cells(p, "K") = ws.Cells(S, "Q")
Qty2 = WorksheetFunction.SumIf(Range(ws.Cells(10, "M"), ws.Cells(LS, "M")), _
sh.Cells(p, "G"), Range(ws.Cells(10, "P"), ws.Cells(LS, "P")))
sh.Cells(p, "J") = Qty2
End If
Next
Application.ScreenUpdating = True
End Sub

 

 

ممكن الايميل الخاص بك يااستاذ زيرو العجوز 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept