ناصرالمصرى قام بنشر فبراير 22, 2017 قام بنشر فبراير 22, 2017 (معدل) الاحباب الكرام أحباب رسول الله " صلى الله عليه وسلم " السلام عليكم ورحمته الله وبركاته بعد طلب الاذن من حضراتكم برجاء المساعدة فى المرفق التالى وهو عبارة عن ورقتين الورقة الاولى " أرشيف " ويتم ترحيل جميع الكميات الواردة والمنصرفة من الاصناف اليها على مدار الشهر الورقة الثانية " بيان تجميعى " والمطلوب فيها بإذن الله تعالى كود مهمته تجميع ونقل الكميات الواردة من الاعمدة 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 تم تعديل فبراير 22, 2017 بواسطه ناصرالمصرى
ابراهيم الحداد قام بنشر فبراير 22, 2017 قام بنشر فبراير 22, 2017 السلام عليكم ورحمة الله انسخ الكود التالى والصقه فى موديول وخصص له زر 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 2
ناصرالمصرى قام بنشر فبراير 23, 2017 الكاتب قام بنشر فبراير 23, 2017 أستاذى الفاضل / زيزو العجوز السلام عليكم ورحمته الله وبركاته بداية بارك الله فيكم وجزاكم الله خيرا واعتذر للتأخير فى الرد لظروف طارئة فى الحقيقة يعجز لسانى أمام هذا الجهد الكبير جعله الله تعالى فى موازيين حسناتكم ارغب فى إضافتين هذا بعد إذن حضرتك الاضافة الاولى الا وهى الترقيم التلقائى بالورقة " بيان تجميعى" اما الاضافة الاخرى بذات الورقة فهى ترتيب الاكواد كما هو بالمرفق التالى **** شاكر فضل حضرتك وجزاكم الله خيرا تجميع الكميات الواردة والمنصرفه على اساس كود الصنف+1111.rar
ابراهيم الحداد قام بنشر فبراير 23, 2017 قام بنشر فبراير 23, 2017 السلام عليكم ورحمة الله تفضل تجميع الكميات الواردة والمنصرفه على اساس كود الصنف+1111.rar 1
ناصرالمصرى قام بنشر فبراير 24, 2017 الكاتب قام بنشر فبراير 24, 2017 أستاذى الفاضل / زيزو العجوز السلام عليكم ورحمته الله وبركاته بارك الله فيكم *** نعم هو كذلك شاكر فضل حضرتك وجزاكم الله خيرا
ابو يوسف العلفي قام بنشر فبراير 26, 2017 قام بنشر فبراير 26, 2017 في ٢٣/٢/٢٠١٧ 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.