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

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

ناصرالمصرى

بواسطه ناصرالمصرى
في منتدى الاكسيل 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

 

 

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

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

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

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

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

سجل حساب جديد

تسجيل دخول

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

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

Important Information

  I accept