انشاء كود تجميع مدى مطاطي باستثناء الخلية الاخيرة

[حسين مامون]

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

الاساتذة الكرام 

اريد مجموع العمود J في الخلية L2 باستثناء الخلية الاخيرة  علما ان كل شهر تضاف بيانات اخرى  لذلك يجب ان يكون المدى مطاطيا  يعني كلما تضاف بيانات في الصف الاخير يضيف للمدى السابق صف ماقبل الاخير

ويشمل هذا جميع الصفحات من صفحة1 حتى اخر صفحة

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

2اصناف.rar

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم حسين

هل المطلوب في جميع أوراق العمل أم أن هناك أوراق عمل أخرى مستثناة ..؟

وهل تريد الحل بالمعادلات أم بالاكواد .. لم تحدد الطريقة المطلوبة؟

[حسين مامون]

السلام عليكم 

الف الف شكر لك استاذنا ابو البراء

المطلوب في جميع الاوراق بكود vba واقصد الاورق المسماة 1 و 2 و 3 و 4 و 5 والى اخره

نعم اخي هنا اوراق مستثاة قمت بحدفها من المرفق  

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

تحياتي

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

ربما هذه المعادلة تقوم يهذا الشيء(دون كود)

=SUMPRODUCT($J$4:INDEX($J$4:$J$200,COUNTIF($J$4:$J$200,"<>0")-1))

 

[ياسر خليل أبو البراء]

وعليكم السلام

جرب الكود التالي عله يفي بالغرض

Sub Test()
    Dim ws      As Worksheet
    Dim lr      As Long
    
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets(Array("1", "2", "3", "4", "5"))
        lr = LastRowNonZero(ws.Name, "J") - 1
        ws.Range("L2").Value = Application.WorksheetFunction.Sum(ws.Range("J4:J" & lr))
    Next ws
    Application.ScreenUpdating = True
End Sub

Public Function LastRowNonZero(ShtName As String, ColumnLetter As String) As Long
    Dim cel         As Range

    Set cel = Sheets(ShtName).Cells(Rows.Count, ColumnLetter).End(xlUp)
    Do While cel.Value <= 0 Or Not IsNumeric(cel)
        Set cel = cel.Offset(-1)
    Loop

    LastRowNonZero = cel.Row
End Function

 

[حسين مامون]

شكرا لكم على ما تقدمون من علم وارجو من الله ان يحفظكم  ويعلو شانكم ويجزيكم خيرا

ساجرب وارد ان شاء الله

[ياسر خليل أبو البراء]

وهذه معادلة أخرى تفي بالغرض إن شاء الله

=SUM(OFFSET($J$4,0,0,COUNTIF($J$4:$J$100,">0")-1,1))

 

[حسين مامون]

الف الف شكر اخي 

في اي خلية اضع المعادلة

الكود ممتاز ولكن يتحكم في 5 صفحات فقط 

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

10 دقائق مضت, حسين مامون said:

الف الف شكر اخي 

في اي خلية اضع المعادلة

الكود ممتاز ولكن يتحكم في 5 صفحات فقط 

صعها اينما تريد

[حسين مامون]

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

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

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

38 دقائق مضت, ياسر خليل أبو البراء said:

وهذه معادلة أخرى تفي بالغرض إن شاء الله

=SUM(OFFSET($J$4,0,0,COUNTIF($J$4:$J$100,">0")-1,1))

 

اخي ياسر

خطرت على بالي معادلة Offset لكني لا أحبذها لانها كما تعرف Volatile

[حسين مامون]

السلام عليكم 

المعادلة لاتعمل اذا كانت قيمة الخلية 0

تحياتي

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

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

السلام عليكم 

المعادلة لاتعمل اذا كانت قيمة الخلية 0

تحياتي

و ما الفرق اذا كنت تجمع ارقم 0

[ياسر خليل أبو البراء]

لديك حل بالأكواد .. وهذا ما تريده .. 

[حسين مامون]

السلام عليكم

نعم استاذ حل الاكواد افضل ولكن الذي سيتعامل مع الملف لايعلم ان الكود مصمم ليعمل مع 5 صفحات فقط ان امكن تعديل الكود ليعمل ولو اضفنا صفحات اخر فهذا احسن

او تعديل المعادلة حسب الشرح في المرفق

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

3اصناف.rar

[ياسر خليل أبو البراء]

يمكن إضافة أوراق عمل كما تريد من خلال السطر الموضح في الحلقة التكرارية .. جملة Array .. والمعادلة تعمل حسب المرفق الأول .. سواء معادلة الأخ سليم أو المعادلة التي قدمتها

وأنا لا أعمل على أكثر من مرفق في الموضوع الواحد .. أعتذر إليك 

[حسين مامون]

الف الف شكر استاذ جزاك الله خيرا  

تحياتي

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

جرب هذا الكود

Option Explicit

Sub calcalate_last_minus_One()
Dim k%, Final_Row%, x%, i%, m#, s#
     With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
k = Sheets.Count
  For x = 1 To k
        m = 0: s = 0
    Final_Row = Sheets(x).Cells(Rows.Count, "J").End(3).Row
        For i = 4 To Final_Row
            If IsNumeric(Sheets(x).Range("j" & i)) And Sheets(x).Range("j" & i) <> 0 Then
                m = Range("j" & i).Value: s = s + m
            End If
        Next
        Sheets(x).Range("L2") = s - m
   Next
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

 

[حسين مامون]

السلام عليكم 

اشكرك استاذ سليم حاصبيا  على ما قدمته و جزاك الله خيرا

نعم اخي هذا ما اريد بالظبط

بس فيه طلب بسيط وهو استثناء شيت "الرئيسية"و"طباعة"من عمل الكود

واعتدر منكم تعبتكم معي 

تحياتي

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

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

السلام عليكم 

اشكرك استاذ سليم حاصبيا  على ما قدمته و جزاك الله خيرا

نعم اخي هذا ما اريد بالظبط

بس فيه طلب بسيط وهو استثناء شيت "الرئيسية"و"طباعة"من عمل الكود

واعتدر منكم تعبتكم معي 

تحياتي

ضع شيت "الرئيسية" في أول المصنف و "طباعة" قي اخره من حبث الترتيب

استبدل For x = 1 To k بـــــ     1-For x = 2 To k

[ياسر خليل أبو البراء]

أو قم بعملية الاستثناء بعد سطر الحلقة التكرارية 

For x = 1 To k

حيث يمكن أن تستخدم جملة الشرط IF وتقول إذا كانت ورقة العمل المتغيرة Sheets(x) لا تساوي كذا و (تستخدم And) لا تساوي كذا .. وأكمل .. و لاتنسى إغلاق جملة الشرط بجملة End IF

للمزيد 

 

[مهند الزيدي]

وفقك الله اخي العزيز ياسر خليل..دائما مانجد الحلول المناسبة عندك

[ياسر خليل أبو البراء]

بارك الله فيك أخي العزيز مهند .. وفقني الله وإياك لكل خير