fofolofo2003 قام بنشر يناير 19, 2005 قام بنشر يناير 19, 2005 عملت شئ شبيه لفاتورة مكون من تاريخ / اسم الصنف / سعره الخ فى ورقة عمل وما اريده انى كلما ادخل فاتورة فى الصفحة الاولى مثلا ان يرحل كل صنف لورقتة الخاصه به فتكون بيانات الفاتورة الاولى يليها فى الصف الفاتورة الثانية ببياناتها وهكذا مع ملاحظة اننى وانا ادخل بيانات الفاتورة يمكن ان تحتوى على اكثر من صنف فالمطلوب ان يرحل كل صنف الى صفحته للتوضيح الورقة الاولى يكون فيها شكل للفاتورة ادخل بيانات الفاتورة فترحل لباقى الصفح بيانات هذه الفاتورة معتمدة على الاصناف التى تحتويها الفاتورة المدخلة بالورقة الاولى
محمد حجازي قام بنشر يناير 30, 2005 قام بنشر يناير 30, 2005 السلام عليكم ... تفضل المرفق : وتذكر أن الكود ينقل فقط القيم وليس التنسيقات ، وإذا كنت تريد نقل التنسيقات فأخبرمني MoveValue.zip
fofolofo2003 قام بنشر يناير 31, 2005 الكاتب قام بنشر يناير 31, 2005 شاكر لمعاليك جدا اخ محمد حجازى لو ممكن ارفاق شرح للمثال وكيفية نقل التنسيقات ايضا لو وقت حضرتك سمح بذلك
محمد حجازي قام بنشر يناير 31, 2005 قام بنشر يناير 31, 2005 السلام عليكم ... الكود هو التالي : Sub MoveValue() Dim EndRow As Long For i = 2 To 4 EndRow = Sheets(i).Range("A1").CurrentRegion.Rows.Count Sheets(i).Cells(EndRow + 1, 1).Value = EndRow Sheets(i).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(1, 2).Value Sheets(i).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(2, 2).Value Sheets(i).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(i + 3, 2).Value Sheets(i).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(i + 3, 3).Value Sheets(i).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(i + 3, 4).Value Next i Sheets(1).Range("B1:B2,B5:D7").ClearContents End Sub وهذا شرح سريع لها : Dim EndRow As Long في السطر السابق عرفنا متغير EndRow من نوع Long بعدها توجد حلقة تكرارية تسند في كل دورة قيمة من 2 إلى 4 (و التي تمثل ترتيب الأوراق A و B و C) في المتغير i ، و الهدف من الحلقة التكرارية تقليص حجم الكود . EndRow = Sheets(i).Range("A1").CurrentRegion.Rows.Count هنا نسند في المتغير EndRow رقم آخر سطر في ورقة الصنف ذات الترتيب i. Sheets(i).Cells(EndRow + 1, 1).Value = EndRow هنا ندرج الرقم في خلايا العامود "مسلسل". Sheets(i).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(1, 2).Value Sheets(i).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(2, 2).Value Sheets(i).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(i + 3, 2).Value Sheets(i).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(i + 3, 3).Value Sheets(i).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(i + 3, 4).Value هنا عملية مناقلة للخلايا بين الورقتين. Sheets(1).Range("B1:B2,B5:D7").ClearContents هنا نمسح في آخر الكود قيم الخلايا الموجودة في النموذج الأصلي.
fofolofo2003 قام بنشر فبراير 2, 2005 الكاتب قام بنشر فبراير 2, 2005 سلام عليكم استاذ محمد حجازى عذرا اخ محمد بالنسبة اسماء الاصناف متغيرة وليست ثابته وكان (a-b-c) مجرد مثال لاى صنف يكتب ويرجى الوضع فى الحسبان ان الاصناف التى يمكن ان تحتويها الفاتورة عدد غير محدد وللايضاح فمثلا ان هناك ورقه بها اسماء جميع الاصناف المتعامل بها ولا يخفى عن حضرتك ان هذه الصفحه عرضه للادخال اصناف جديده ولحذف اصناف ايضا والمراد كما تفضلت حضرتك وقمت به انه عند الادخال فى صفحه الفاتورة ان ترحل كما تفضلت حضرتك مشكورا بعمله فى المثال كل بيانات صنف الى ورقته الخاصه به ولكن يرجى الوضع فى الحسبان تغير اسماء الاصناف المدخله فى كل مرة وانها ليست ثابته حاولت التعديل فى التكلفة لكى تكون حاصل ضرب السعر × الكمية وبالفعل تتم العملية بنجاح ولكن يتم كتابه المعادله الخاصه بذلك فى كل مرة يتم ادخال الفاتورة والمطلوب ان تظل المعادلة ثابته ناسف عن الاطالة وشاكرين مسبقا ومقدما لحضرتك اهتمامك
محمد حجازي قام بنشر فبراير 3, 2005 قام بنشر فبراير 3, 2005 السلام عليكم ... هذا الكود مع التعديل : Sub MoveValue() On Error GoTo 1 Dim EndRow As Long Dim MyCell As Range For i = 2 To ActiveWorkbook.Worksheets.Count EndRow = Sheets(i).Range("A1").CurrentRegion.Rows.Count Set MyCell = Sheets(1).Range("A5:A7").Find(Sheets(i).Name) Sheets(i).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(MyCell.Row, 2).Value Sheets(i).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(MyCell.Row, 3).Value Sheets(i).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(MyCell.Row, 4).Value Sheets(i).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(1, 2).Value Sheets(i).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(2, 2).Value Sheets(i).Cells(EndRow + 1, 1).Value = EndRow Sheets(1).Range(Cells(MyCell.Row, 2), Cells(MyCell.Row, 3)).ClearContents 1 Next i Sheets(1).Range("B1:B2").ClearContents End Sub ولكن انتبه للملاحظات التالية : - غير المجال الذي يحتوي على أسماء الأصناف من السطر السادس (من الكود) ، كأن تقوم مثلاً بتحديد مجال أعظمي للبيانات المدخلة. - يجب أن تكون أسماء الأصناف في ورقة الفاتورة مطابقة تماماً لأسماء الأوراق ، وإلا سيقوم الكود بتجاهل الصنف الغير معروف ولن يرحل صف هذا الصنف. - بالنسبة لمعادلة السعر × الكمية أضفها في العامود D ولن تمسح إن شاء الله. بالتوفيق
fofolofo2003 قام بنشر فبراير 8, 2005 الكاتب قام بنشر فبراير 8, 2005 شكرا لمعاليك جدا استاذ محمد استفسار لو سمحتلى استاذ محمد هل من الممكن ان تكون الصفحه التى يتم ادخال البيانات بها ان تكون الفاتورة اما فاتورة مشتريات او مبيعات على حسب ما يحدد له عند ادخال البيانات وترحل الى كل صفحه صنف تباعا وزيادة عمود لنوع الفاتورة ( مشتريات ا، مبيعات ) فى صفحات الاصناف مع مراعاة عدم تغير فى شكل صفحة الفاتورة زياده بيان فقط يحدد اذا كانت فاتورة مشتريات او مبيعات
محمد حجازي قام بنشر فبراير 9, 2005 قام بنشر فبراير 9, 2005 السلام عليكم ... جرب التعديل التالي: MoveValue.zip
الردود الموصى بها