أبو العاصم

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

السلام عليكم ورحمة الله ا/ ياسر الشيخ معذرة لم أرى ردك ا / ياسر خليل بارك الله فيك ردك هو عين المطلوب جزاك الله خيرا على تعاونك مع المشاركين وجعل ذلك فى ميزان حسناتك لقد حاولت تطبيق الكود على الملف الأصلى لكن لقلة الخبرة بالـ VBA لم أتمكن من تطبيق الكود فأرفقت الملف فلتتكرم وتطبق عليه الكود REG.rar

السلام عليكم ورحمة الله أحبابى أعضاء المنتدى العظيم أوفيسنا الملف المرفق به كود يقوم بعمل تسلسل تلقائى جيد جدا وأود وأطلب إضافة كود ترصيد بسيط ( رصيد سابق + وارد - منصرف ) مع كود التسلسل التلقائى وتظهر لى رسالة كلما قمت بحفظ الملف فهل من حل لها وجزاكم الله خيرا ترصيد.rar

السلام عليكم ورحمة الله أخى العزيز ياسر جزاك الله خيرا والله إنى لأعتذر عن عدم توضيح المطلوب السابق وكبدتك مزيدا من الوقت إقبل أسفى على ذلك المطلوب ليس فى صفحات الاكسيل وانما فى صفحات الطباعة فإذا كان محتوى الخلية الأولى A1 = on يكون نطاق الطباعة هو A3:M15 فى صفحة طباعة رقم 1 فإذا كان محتوى الخلية الأولى A1 = off يكون نطاق الطباعة هو A3:M30 بحيث المدى A3:M15 فى صفحة الطباعة رقم 1 والمــــــــدى A16:M30 فى صفحة الطباعة رقم 2 تقبل إعتذارى ثانيا وجزاك الله خيرا على ما تقدم

للتذكير

السلام عليكم ورحمة الله المهندس ياسر صباحك عسل هل بإمكان تلك الأداة تنفيذ المطلوب التالى عندى ملف ريجيسترى مكون من عدة حقول كل حقل يمثل عملية تشغيل وله رقم مسلسل داخل كل حقل 6 اعمدة 3 منها ثوابت كالرأس و3 للإدخال هل من الممكن تطبيق الجداول المحوريه PIVET TABEL عليه للوصول للتقرير بدون استخدام دالة البحث لان الملف سيزيد حجمه بطريقه بشعة وستستغرق عملية حساب المعادلات وقتا طويلا أنا الان اعمل عليه بمعادلات البحث لكننى أود الدخول به فى عالم PIVET TABEL المرفق يوضح جزاك الله خيرا http://www.officena.net/ib/index.php?showtopic=59566#entry381593 PIVET TABEL_T.rar

للرفع

هل بالإمكان تطبيق الكود المرفق فى المشاركة قبل السابقة لينك الموقع مرفق فلو تكرم علينا المفضال ياسر خليل بتركيب الكود على ملف إكسيل للإستفادة منه لكان خيرا كثيرا

الحمد لله توصلت إلى نتائج قريبة للمطلوب سأرفقها لكم بغية التطوير والوصول لما ننشد والشكر موصول للسيد ياسر خليل والسيد أحمد عبد الناصر والسيد محمد الريفى بارك الله فيكم جميعا

للرفع ومعذرة على الالحاح

جملة ما توصلت إليه من البحث هو الموقع التالى به أكواد لا أعلم هل تفيد فى المطلوب أم لا الصراحة حلوة :( http://www.mrexcel.com/forum/excel-questions/167756-inventory-fifo-lifo-average-cost.html =========================================== Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then FIFO End With End Sub ============================================== Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then LIFO End With End Sub ================================================ Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then AVR_COST End With End Sub ========================================== Sub FIFO() Dim a As Variant, Cost As Double, sumIn As Double, sumOut As Double, _ i As Long, ii As Long, n As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("FIFO") .Range("i7", .Cells(Rows.Count, "i").End(xlUp)).ClearContents a = .Range("e7", .Cells(Rows.Count, "g").End(xlUp)).Resize(, 5).Value n = 1 For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 3)) Then sumOut = a(i, 3) For ii = n To i - 1 If Not IsEmpty(a(ii, 2)) Then sumIn = sumIn + a(ii, 2) If sumIn > sumOut Then Exit For Else Cost = Cost + a(ii, 1) * a(ii, 2) a(ii, 2) = Empty End If End If Next If sumIn - sumOut > 0 Then Cost = (Cost + (a(ii, 1) * (a(ii, 2) - (sumIn - sumOut)))) / sumOut a(ii, 2) = sumIn - sumOut Else Cost = Cost / sumOut End If a(i, 5) = Cost sumIn = 0: sumOut = 0: Cost = 0: n = ii End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 5) Erase a End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub ============================================================ Sub LIFO() Dim a As Variant, Cost As Double, sumIn As Double, sumOut As Double, _ i As Long, ii As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("LIFO") .Range("i7", .Cells(Rows.Count, "i").End(xlUp)).ClearContents a = .Range("e7", .Cells(Rows.Count, "g").End(xlUp)).Resize(, 5).Value For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 3)) Then sumOut = a(i, 3) For ii = i - 1 To 1 Step -1 If Not IsEmpty(a(ii, 2)) Then sumIn = sumIn + a(ii, 2) If sumIn > sumOut Then Exit For Else Cost = Cost + a(ii, 1) * a(ii, 2) a(ii, 2) = Empty End If End If Next If sumIn - sumOut > 0 Then Cost = (Cost + (a(ii, 1) * (a(ii, 2) - (sumIn - sumOut)))) / sumOut a(ii, 2) = sumIn - sumOut Else Cost = Cost / sumOut End If a(i, 5) = Cost sumIn = 0: sumOut = 0: Cost = 0: n = ii End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, , 5) Erase a End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Erase a End Sub ============================================== Sub AVR_COST() Dim a, i As Long, Bal As Double, Debit As Double Dim AVcost As Double With Application .Calculation = xlCalculationManual .EnableEvents = False End With With Sheets("AVR COST") a = .Range("e7", .Cells(.Rows.Count, "g").End(xlUp)).Resize(, 3).Value .Range("i7", .Cells(.Rows.Count, "i").End(xlUp)).ClearContents ReDim Preserve a(1 To UBound(a, 1), 1 To 4) For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) > 0 Then Bal = Bal + a(i, 2) Debit = Debit + a(i, 1) * a(i, 2) AVcost = Debit / Bal ElseIf a(i, 3) > 0 Then a(i, 4) = AVcost Debit = Debit - a(i, 3) * AVcost Bal = Bal - a(i, 3) End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 4) Erase a End With With Application .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub ================================== وهناك Advanced Sumproduct Queries http://chandoo.org/wp/2011/05/26/advanced-sumproduct-queries/

الأخ أجمد عبد الناصر المرفق يؤدى عين المطلوب لكن المشكلة الكبيرة فيه هو شرط وضع الأصناف مرتبة فأنا أعمل مع 5000 صنف كل مرة بيع أو شراء المخزن يتحرك 20 صنف فالموضوع سيكون مضنى أن أتحرك فى 5000 صنف كل مرة لأسجل 20 صنف فهل من معادلة لتتغاضى عن كون الاصناف مرتبة تحت بعضها

والله جزاك الله خيرا على سرعة ردك وانا أحاول منذ ردك أن اصل الى المطلوب الذى أريدة هو حساب المتوسط المرجح المتحرك لكل صنف لكل عملية شراء المعادلة المطلوبة لحساب تكلفة البضاعة المباعة فهى مرتبطة بعمود الرصيد المجاور للمعادلة المطلوبة بمعنى أنه كلما قمت بالشراء يتغير تكلفة الصنف كل مرة على حسب المتبقى من الوحدات وسعر شراءها واذا بعت الصنف من المخزن كله يحذف من حسابه تكلفة الشراء السابقه بمعنى = عدد الوحدات المشتراه * تكلفة شراءها / الرصيد >0 اللى هو ( الوارد - المنصرف ) وذلك لكل صنف والله لقد توهت فى المطلوب هذا وفتحت صفحات أجنبية للوصول للمطلوب واكتشفت انه من الممكن تركيب معادلات أخرى للوصول للحل لكنى لم أصل اليه معادلة المتوسط المرجح المتحرك.rar

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

للرفع

للرفع

جزاك الله خيرا أخ محمد الريفى لكن المعادلة لا تعطى الناتج السليم جرب شراء 5 وحدات بـ 10 ج م ثم بيعهم ثم شراء 3 وحدات بـ 11 تعطى متوسط مرجح تعطى 10.375 فى حين انه 11 المعادلة اللى وضعتها انت فى العمود G مرتبطة بالعمود A أصناف والعمود B كميات والعمود C أسعار شراء المطلوب الاعتماد على العمود F لانه عمود الرصيد الموجود فى المخزن وليس العمود B كميات الوارد

لله درهم

أخ ياسر خليل بارك الله فيك معادلة حضرتك =IF(A3="","",SUMPRODUCT(($B$3:B3-$D$3:D3),--($A$3:A3=$A3))) تعديلى هذا لعلاج المطلوب اللى هو لو لم يكن هناك صنف يعتمد على عمود الاصناف المطلوب الثانى أنا حاطيت معادلة فى أول 3 خلايا لتنفيذ المطلوب وكتبت جنب المعادلة الناتج اللى انا عاوزه وباقى الخلايا فى العمود كاتب فيها المطلوب بالارقام وجزيت خيرا على سرعة ردك على طلبى

فى الملف المرفق الرجاء المساعد للوصول الى المتوسط المرجح لكل عملية شراء أو بيع تعتمد على نوع الصنف وتحسب المتوسط المرجح لعمليات الشراء المخزون.rar

السلام عليكم ورحمة الله أثناء التنقل بين المنتديات وقعت على كود لعملية حساب المخزون أود من الإخوة المباركين المساعدة فى إدارج الكود فى ملف إكسيل لفهمه ومحاولة تطبيقه الرابط وبه صورة لشيت الاكسيل الذى طبق عليه الكود http://www.mrexcel.com/forum/excel-questions/167756-inventory-fifo-lifo-average-cost.html الكود الأول Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then FIFO End With End Sub الكود الثانى Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then LIFO End With End Sub الكود الثالث Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then AVR_COST End With End Sub كود المعادلات البلتى إن Sub FIFO() Dim a As Variant, Cost As Double, sumIn As Double, sumOut As Double, _ i As Long, ii As Long, n As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("FIFO") .Range("i7", .Cells(Rows.Count, "i").End(xlUp)).ClearContents a = .Range("e7", .Cells(Rows.Count, "g").End(xlUp)).Resize(, 5).Value n = 1 For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 3)) Then sumOut = a(i, 3) For ii = n To i - 1 If Not IsEmpty(a(ii, 2)) Then sumIn = sumIn + a(ii, 2) If sumIn > sumOut Then Exit For Else Cost = Cost + a(ii, 1) * a(ii, 2) a(ii, 2) = Empty End If End If Next If sumIn - sumOut > 0 Then Cost = (Cost + (a(ii, 1) * (a(ii, 2) - (sumIn - sumOut)))) / sumOut a(ii, 2) = sumIn - sumOut Else Cost = Cost / sumOut End If a(i, 5) = Cost sumIn = 0: sumOut = 0: Cost = 0: n = ii End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 5) Erase a End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub Sub LIFO() Dim a As Variant, Cost As Double, sumIn As Double, sumOut As Double, _ i As Long, ii As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("LIFO") .Range("i7", .Cells(Rows.Count, "i").End(xlUp)).ClearContents a = .Range("e7", .Cells(Rows.Count, "g").End(xlUp)).Resize(, 5).Value For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 3)) Then sumOut = a(i, 3) For ii = i - 1 To 1 Step -1 If Not IsEmpty(a(ii, 2)) Then sumIn = sumIn + a(ii, 2) If sumIn > sumOut Then Exit For Else Cost = Cost + a(ii, 1) * a(ii, 2) a(ii, 2) = Empty End If End If Next If sumIn - sumOut > 0 Then Cost = (Cost + (a(ii, 1) * (a(ii, 2) - (sumIn - sumOut)))) / sumOut a(ii, 2) = sumIn - sumOut Else Cost = Cost / sumOut End If a(i, 5) = Cost sumIn = 0: sumOut = 0: Cost = 0: n = ii End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, , 5) Erase a End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Erase a End Sub Sub AVR_COST() Dim a, i As Long, Bal As Double, Debit As Double Dim AVcost As Double With Application .Calculation = xlCalculationManual .EnableEvents = False End With With Sheets("AVR COST") a = .Range("e7", .Cells(.Rows.Count, "g").End(xlUp)).Resize(, 3).Value .Range("i7", .Cells(.Rows.Count, "i").End(xlUp)).ClearContents ReDim Preserve a(1 To UBound(a, 1), 1 To 4) For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) > 0 Then Bal = Bal + a(i, 2) Debit = Debit + a(i, 1) * a(i, 2) AVcost = Debit / Bal ElseIf a(i, 3) > 0 Then a(i, 4) = AVcost Debit = Debit - a(i, 3) * AVcost Bal = Bal - a(i, 3) End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 4) Erase a End With With Application .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub الرجاء الإهتمام لإثراء الفكرة وتطبيقها

هلا بالتذكير يا شباب

السلام عليكم ورحمة الله فى الملف المرفق مطلوب معادلة لحساب المتوسط المرجح للمشتريات وهو يشرح نفسه ولكن هل من إهل الخبرة من تمكن من حساب تكلفة البضاعة المباعة بطريقة FIFO أو LIFO بحثت فوجدت أكواد لحل تلك المسألة فهل من متمكن سبق الى هذا الامر بالاكواد أو المعادلات وبوركتم مخزون.rar

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

السلام عليكم ورحمة الله عندى ملف ريجيسترى مكون من عدة حقول كل حقل يمثل عملية تشغيل وله رقم مسلسل داخل كل حقل 6 اعمدة 3 منها ثوابت كالرأس و3 للإدخال هل من الممكن تطبيق الجداول المحوريه PIVET TABEL عليه للوصول للتقرير بدون استخدام دالة البحث لان الملف سيزيد حجمه بطريقه بشعة وستستغرق عملية حساب المعادلات وقتا طويلا أنا الان اعمل عليه بمعادلات البحث لكننى أود الدخول به فى عالم PIVET TABEL المرفق يوضح جزاكم الله خيرا المرفق مجرد الفكرة وإذا من الله علينا بمن يحل فجزاه الله خيرا ان قام بالشرح PIVET TABEL.rar