اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


ahmed sherif
إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

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

اريد عمل عملية جمع لجدول عدد الصفوف فيه ثابتة ولتكن 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

 

  • Like 2
رابط هذا التعليق
شارك

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

هذا الكود

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

  • Like 2
رابط هذا التعليق
شارك

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

استاذ سليم السلام عليكم انا عملت تعديل لشكل الجمع كنوع من انواع التدريب نجح الامر فى الشيت رقم 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

 

 

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

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

لكن الجزء اللى منوقف فيه هو فى الشيت رقم 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

  • Like 2
رابط هذا التعليق
شارك

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

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

  • Like 2
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information