أبو زهرة قام بنشر مارس 29, 2014 مشاركة قام بنشر مارس 29, 2014 السلام عليكم . هل يمكن عمل كود لاضافة صف (الاجمالى) لكل 15 صف . بحيث يتم الاضافة تلقائى الملف فى المرفقات Book20.rar رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مارس 30, 2014 مشاركة قام بنشر مارس 30, 2014 السلام عليكم هذه الطريقة بلا كود قد تعجبك يمكن إضافة عمود قبل الجدول (وليكن باللون الأزرق) لحساب رقم الصفحة الذي يتغير كل 15 صف ثم من قائمة Data ثم Subtotal وبناءا علي هذا العمود الجديد يمكن عمل ذلك وستلاحظ الأرقام 1-2-3 في أعلي اليمين التي تكونت نتيجة ذلك إضغط علي كلا منها علي حدي لتتعرف عليها تفضل المرفق Book20.rar 3 رابط هذا التعليق شارك More sharing options...
أبو زهرة قام بنشر مارس 30, 2014 الكاتب مشاركة قام بنشر مارس 30, 2014 جزاك الله خيرا استاذ / طارق أعجبتنى هذه الطريقة فعلا. ولكن هل تتأثر اذا كانت الصفحة داخلها معادلات أخرى رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مارس 30, 2014 مشاركة قام بنشر مارس 30, 2014 السلام عليكم و رحمة الله اخي محمد اليك ما طلبت النموذج على الصفحة (ورقة 2(1)) تستطيع ان تلمؤه بما بناسبك (احفظ نسخة احتياطية عن الملف قبل البدء بالعمل) حتى تتدارك الأخطاء فيما لو حصلت جمع اختياري.rar 1 رابط هذا التعليق شارك More sharing options...
أبو زهرة قام بنشر مارس 30, 2014 الكاتب مشاركة قام بنشر مارس 30, 2014 بارك الله فيك. رائعة هذه الطريقة رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مارس 31, 2014 مشاركة قام بنشر مارس 31, 2014 السلام عليكم أخي / محمد رزق ولكن هل تتأثر اذا كانت الصفحة داخلها معادلات أخرى لا ياأخي لاتتأثر بالمعادلات أخي / سليم حاصبيا تسلم يداك الكود جيد جدا فقط ياأخي يحدث خطأ في الجمع الأخير إذا لم يكن عدد الصفوف يقبل القسمة علي الرقم الإختياري في الخلية (I2) جرب وشوف ، مثلا في الشيت <ورقة1 (2)> إذا إخترت رقم 7 في الخلية (I2) ستجد أن آخر مجموع قد جمع آخر 7 صفوف أي أنه كرر صفين من الجمع السابق وكذلك أضاف المجموع السابق للمجموع الحالي أي أنه بدلا من 500 + 540 + 600 + 230 + 240 = 2110فإنه يعطي 230 + 240 + 2250 + 500 + 540 + 600 + 230 + 240 = 4830 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مارس 31, 2014 مشاركة قام بنشر مارس 31, 2014 السلام عليكم استاذ طارق لقد اكتشفت هذا الخطأ بعد فوات الأوان(اقصد بعد تحميل الملف ) وأعمل جاهداً على تصحيحه. أرجو المساعدة اذا كان عندك فكرة عن هذا الموضوع/علماً اني ابلغت الاستاذ عبدالله باقشير عنه ايضاً. (حسب رأي في الاجمالي يجب ان نجمع الخلايا حسب اللون) رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مارس 31, 2014 مشاركة قام بنشر مارس 31, 2014 السلام عليكم أخي الكريم / سليم حاصبيا لقد اكتشفت هذا الخطأ بعد فوات الأوان(اقصد بعد تحميل الملف ) وأعمل جاهداً على تصحيحه. أرجو المساعدة إستخدمت بعض مافي الكود الخاص بك وأضفت إليه اشياء (إسمح لي) إعتمدت أنه في كل مرة يحسب من جديد أول سطر سيبدأ منه المعادلة وآخر سطر وإذا كان آخر سطر أكبر من رقم السطر الأخير في البيانات فسيغير المعادلة قليلا واضفت أيضا (بدلا من تكرار المعادلة) خاصية FillRight التي تسمح بنسخ الخلية لليمين في المجال المحدد هذا هو الكود الجديد Sub sub_tot() k = [I2]: tx = "المجموع" Application.ScreenUpdating = False LR = [A9999].End(xlUp).Row rw_n = LR - 5 st_rw = 6 'start row for the sum sm_n = Int(rw_n / k) + 1 For i = 1 To sm_n X = k + st_rw ' X is end row for the sum If X > LR Then X = LR + 1: k = X - st_rw LR = LR + 1 Rows(X).Rows.Insert Shift:=xlDown Cells(X, 1) = tx Cells(X, 2).FormulaR1C1 = "=SUM(R[-" & k & "]C:R[-1]C)" With Range(Cells(X, 1), Cells(X, 11)) .Interior.Color = 65535 .Font.Bold = True .Font.Size = 25 End With Range(Cells(X, 2), Cells(X, 11)).FillRight st_rw = st_rw + k + 1 Next i Application.ScreenUpdating = True End Sub تفضل المرفق جرب وشوف جمع اختياري2.rar رابط هذا التعليق شارك More sharing options...
أبو عبد الرحمن سعيد قام بنشر مارس 31, 2014 مشاركة قام بنشر مارس 31, 2014 (معدل) اخى العزيز الفاضل المهندس // طارق محمود بارك الله فيكم وجزاكم الله خيرا تعديل جوهرى من جوهرة ثمينة ذو كفائة عاليه وعقلية منيرة بسم الله ماشاء الله وافر تقديرى واحترامى تم تعديل مارس 31, 2014 بواسطه سعيد بيرم رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مارس 31, 2014 مشاركة قام بنشر مارس 31, 2014 استاذ طارق مشكور جداً على هذا الكود الجديد لكني لاحظت انه لايقوم بالجمع بكشل صحيح في الصف الأخير و اذا فعل ذلك فانه اذا غيرت رقم الاختيار لا يعيد احتساب الجدول ،بل يضيف عدة مجاميع الى الجدول/ يرجى اعادة النظر و وضع اليد على الخطأ ولكم الشكر جمع اختياري3.rar رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر أبريل 1, 2014 مشاركة قام بنشر أبريل 1, 2014 السلام عليكم عندك حق أضف للكود هذا الجزء For r = LR To 6 Step -1 If Cells(r, 1) = tx Then Rows(r).Rows.Delete Shift:=xlUp Next r LR = [A9999].End(xlUp).Row وأيضا هذا السطر If st_rw > LR Then GoTo 10 قبل Next i ليصبح الكود النهائي Sub sub_tot() k = [I2]: tx = "المجموع" Application.ScreenUpdating = False LR = [A9999].End(xlUp).Row For r = LR To 6 Step -1 If Cells(r, 1) = tx Then Rows(r).Rows.Delete Shift:=xlUp Next r LR = [A9999].End(xlUp).Row rw_n = LR - 5 st_rw = 6 'start row for the sum sm_n = Int(rw_n / k) + 1 For i = 1 To sm_n X = k + st_rw ' X is end row for the sum If X > (LR + 1) Then X = LR + 1: k = X - st_rw LR = LR + 1 Rows(X).Rows.Insert Shift:=xlDown Cells(X, 1) = tx Cells(X, 2).FormulaR1C1 = "=SUM(R[-" & k & "]C:R[-1]C)" With Range(Cells(X, 1), Cells(X, 11)) .Interior.Color = 65535 .Font.Bold = True .Font.Size = 25 End With Range(Cells(X, 2), Cells(X, 11)).FillRight st_rw = st_rw + k + 1 If st_rw > LR Then GoTo 10 Next i 10 Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أبريل 1, 2014 مشاركة قام بنشر أبريل 1, 2014 و عليكم السلام و رحمته و بركاته لقد اشتغل الكود بشكل ممتاز ألف شكر لك يا استاذ طارق رابط هذا التعليق شارك More sharing options...
ناصرالمصرى قام بنشر أغسطس 4, 2014 مشاركة قام بنشر أغسطس 4, 2014 بارك الله فيكم رابط هذا التعليق شارك More sharing options...
الصـقر قام بنشر أغسطس 4, 2014 مشاركة قام بنشر أغسطس 4, 2014 ما شاء الله كود اكثر من رائع بارك الله فيكم وزادكم الله من علمه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.