معادلة تجميع قيم من عدة صفحات

[حسين مامون]

السلام عليكم ورحمة الله

اخواني اساتذة المنتدى تحياتي للجميع

فضلا اريد افادتي بمعادلة تجمع قيم من عدة صفحات 

مثلا عندي صفحة "تجميع" العمود b ابتداء من الخلية b2 تجمع قيم جميع الخلايا g3 من الصفحات الاخرى  وتكون هذه المعادلة مطاطية يعني تعمل مع الصفحات التي ستضاف لاحقا 

وان امكن استثنا بعض الصفحات مثلا عندي صفحة"الرئيسية" و "طباعة" و"تجميع" تستثنى من عملية الجمع

جزاكم الله خير الجزاء

 

[Ali Mohamed Ali]

وعليكم السلام أخى الكريم

من الأفضل أن ترسل ملف

[حسين مامون]

اخي اشكرك على اهتمامكم

المرفق فيه شرح لما اريد

تحياتي

تجميع قيم.rar

[سليم حاصبيا]

جرب هذا الماكرو  (يكفي ان تخرج من الصفحة ثم تعود اليها لتجد النتيبجة قد سبقتك الى مكانها الصحيح)

اضافة الصفحات يجب ان يكون بعد صفحة "تجميع" و قبل صفحة "طباعة" وذلك كي يعمل الكود بشكل جيد

Private Sub Worksheet_Activate()
Cells(3, "b").Resize(Sheets.Count - 3, 1).Formula = _
"=SUM('1:" & Sheets.Count - 3 & "'!B4)"
Cells(3, "b").Resize(Sheets.Count - 3, 1).Value = _
Cells(3, "b").Resize(Sheets.Count - 3, 1).Value
End Sub

الملف مرفق

 

تجميع قيم salim.xlsm

[حسين مامون]

الف شكر لك استاذي  سليم 

اخي الماكرو يعمل في مدى ("b3:b12") فقط لا يتجاوه هل ممكن تعديله ليعمل  على اكثر من ذلك

تحياتي

تم تعديل مارس 8, 2018 بواسطه حسين مامون

[سليم حاصبيا]

تم تعديل الماكرو ليعمل في جميع الظروف حتى ولو تم تغيير اسماء الصفحات من 1و2و3 الى ما تريد من اسماء

شرط اضافة الشيتات بين الصفحتين "تجميع " و "طباعة"

Option Explicit
Private Sub Worksheet_Activate()
Dim t
Dim first_sheet$: first_sheet = Sheets(3).Name
Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 1).Name
ActiveSheet.Range("b3:b1000").ClearContents
t = "=SUM(" & first_sheet & ":" & last_sheet & "!B4)"

With Cells(3, "b").Resize(Sheets.Count - 3, 1)
    .Formula = t
    .Value = .Value
End With

End Sub

الملف مع تغيير اسماء الشيتات

 

 

تجميع قيم salim 1.xlsm

[حسين مامون]

السلام عليكم

استاذ  قمت بتجربة الماكرو ولكن المشكلة نفسها لايتجاوز عمله في المود (B3:B11) 

الشرح في المرفق جزاك الله خيرا

///// رد

هذه الحالة صحيحة لان عد الصفحات المطلوب حسابها هو 9 (عدد الصفحات الاجمالي ناقص 3)

و (B3:B11) يحتوي على 9 صفوف

تجميع قيم salim 1.rar

[حسين مامون]

السلام عليكم 

الف الف تحية وجزاكم الله خيرا

[سليم حاصبيا]

1 ساعه مضت, حسين مامون said:

السلام عليكم 

الف الف تحية وجزاكم الله خيرا

اذا اردت ان تجمع كل الخلايا من العامود B في كل الصفحات

اليك هذا الماكرو

Option Explicit
Option Base 1
'=======================================
Private Sub CCMD_1_Click()
sum_all_rows_in_all_sheets
End Sub
'===========================================

Sub sum_all_rows_in_all_sheets()
    Dim first_sheet$: first_sheet = Sheets(3).Name
    Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 1).Name
    Dim arr(), lr%, i%, My_Max%: My_Max = 0
    Dim t$, last_row%
    last_row = Sheets("Main_sh").Cells(Rows.Count, 2).End(3).Row
    Sheets("Main_sh").Range("b3:b" & last_row).ClearContents
    Dim First_row%: First_row = 4

 For i = 3 To Sheets.Count - 1
        lr = Sheets(i).Cells(Rows.Count, 2).End(3).Row
        If lr < 3 Then lr = 3
        ReDim Preserve arr(i - 2): arr(i - 2) = lr
 Next
 
   For i = LBound(arr) To UBound(arr)
    If My_Max < arr(i) Then My_Max = arr(i)
   Next
   
t = "=SUM(" & first_sheet & ":" & last_sheet & "!B" & First_row & ")"

    With Sheets("Main_sh").Cells(3, "b").Resize(My_Max - 3, 1)
        .Formula = t
        .Value = .Value
    End With

End Sub
'========================================

الملف مرفق

 

تجميع قيم salim 2.xlsm

[حسين مامون]

حفظك الله استاذي هذا هو المطلوب اسأل الله ان ينور قلوبكم وان يجعل عملكم هذا في ميزان حسناتكم

تحياتيييييييييييييييييييييييييييييييييييييييي