تكرار عملية جمع عده مرات

[ahmed sherif]

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

اريد عمل عملية جمع لجدول عدد الصفوف فيه ثابتة ولتكن 5 صفوف فى الجدول الواحد

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

اريد ان اتعلم كيف يمكن عمل حلقة تكرارية بحيث يتم جمع الجداول كل واحد على حده لكن مرة واحدة وتكرار المعادلة اكثر من مرةتجارب.xlsm

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub Suming()
Dim LR As Long, i As Long, j As Integer, p As Integer
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
LR = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
MsgBox LR
i = 6
j = i - 5
p = i - 1
Do While i <= LR
ws.Range("A" & i).Value = WorksheetFunction.Sum(ws.Range("A" & j & ":B" & p))
i = i + 7
Loop
End Sub

 

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

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

هذا الكود

Option Explicit
Sub Multi_Sum()
  Dim LR%, t%, m%
With Sheets("Sheet1")
  LR = .Range("A" & Rows.Count).End(xlUp).Row
  For t = 1 To LR
      If Application.CountA(.Cells(t, 1).Resize(, 2)) = 1 Then
      .Cells(t, 1) = vbNullString
    End If
  Next
  
  m = .Range("A1", Range("A1").End(4)).Rows.Count
  t = 1
  
  Do Until t > LR
      With .Range("A" & t + m)
        .Formula = _
        "=SUM(A" & t & ":B" & t + m - 1 & ")"
        .Value = .Value
      End With
    t = t + m + 2
  Loop
End With

End Sub

الملف مرفق

ahmed sherif.xlsm

[ahmed sherif]

جزيل الشكر لكما لدعمكم بهذه الاحابة العبقرية جزاكم الله كل خير

استاذ سليم السلام عليكم انا عملت تعديل لشكل الجمع كنوع من انواع التدريب نجح الامر فى الشيت رقم 1 حاولت فى الشيت رقم 2 زيادة عدد الصفوف الى 9 صفوف بنفس الشكل المعدل لكن النتيجة خاطئة او لم تنفذ بالشكل الصحيح منى طبعا

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

m = .Range("A1", Range("A1").End(4)).Rows.Count وخاصه الجزء اللى بلون احمر

والثانى كيف ازود عدد الصفوف التىتجارب.xlsm اريد جمعها على نفس الشكل بعد التعديل فى الملف المرفق 

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

يالنسية للكود الثّاني صفحة  Sheet1   العامودين K & L

Sub Multi_J_K()
  Dim LR%, t%
    With Sheets("Sheet1")
        LR = .Range("j" & Rows.Count).End(xlUp).Row
        
       For t = 1 To LR
         .Cells(t, "j") = _
           IIf(Application.CountA(.Cells(t, "J") _
           .Resize(, 3)) = 1, vbNullString, .Cells(t, "j"))
       Next
        
        m = .Range("j1", Range("j1").End(4)).Rows.Count
        t = 1
        
        Do Until t > LR
          Cells(t + m + 1, "J") = _
          Application.Sum(Cells(t, "J").Resize(m, 3))
          t = t + m + 3
        Loop
    End With
End Sub

 

 

[ahmed sherif]

استاذ سليم السلام عليكم انا شاكر لآهتمام حضرتك

لكن الجزء اللى منوقف فيه هو فى الشيت رقم 2 

المشكلة هى انى زودت عدد الصفوف الى تسعة بدلا من خمسة

بدءا من الصف الخامس J5 الى  j13

بالاضافة عايز افهم هذا الجزء المحدد End(4)) 

مرفق لضرتكتجارب.xlsm الملف مرة اخرى وشكرا لحضرنك

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

لمعرفة ماذا تعني End(4)
جرب هذا الكود

Sub What_is_End4()
MsgBox Sheets("Sheet1").Range("A1", Range("A1").End(4)).Address
End Sub

بالنسية الصفحة الثّانية هذا الكود

Option Explicit
Sub sum_Of_JL_Sh_2()
  Dim LR%, t%, m%
With Sheets("Sheet2")
    LR = .Range("j" & Rows.Count).End(xlUp).Row
    For t = 5 To LR
     .Cells(t, "j") = _
       IIf(Application.CountA(.Cells(t, "J") _
       .Resize(, 3)) = 1, vbNullString, .Cells(t, "j"))
    Next
    
    m = .Range("j5", Range("j5").End(4)).Rows.Count
    t = 5
    Do While t < LR
        With .Cells(t, "J").Resize(m, 3)
          .Cells(m, 1).Offset(2) = _
          Application.sum(.Value)
        End With
        t = t + m + 3
    Loop
End With
End Sub

الملف مرفق

My_test.xlsm

[ahmed sherif]

شكرا استاذ سليم  على مساعدتك لى وعلى هذه الاضافة العلمية القيمة قد استفدت حقا منها وستفيدنى كثيرا فى  عملى

             

[ahmed sherif]

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

My_test.xlsm

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

تم معالجة الأمر

Sub Sum_With_Blank()
  Dim LR%, t%, m%, k%
    With Sheets("Sheet2")
        LR = .Range("j" & Rows.Count).End(xlUp).Row
        k = 5
          For t = 5 To LR + 2
            If Application.CountA(.Cells(t, "J") _
                .Resize(, 3)) = 0 Then
                    With .Cells(t, "J").Offset(1)
                     .Formula = "=SUM(J" & k & ":L" & t & ")"
                        .Value = IIf(.Value = 0, _
                            vbNullString, .Value)
                        .Value = .Value
                    End With
                 t = t + 2
                 k = t + 1
            End If
    
        Next
        
    End With
End Sub

 

Ahnad_Sh.xlsm

[ahmed sherif]

بسم الله ماشاء الله ربنا يزيدك من فضله