اضافة صف الجمع

[ضياء 2]

السلام عليكم الاساتذة الافاضل بالمنتدى فضلا من كرمكم مساعدة " المطلوب لو ضيفت عميل5 بعد عميل4 وضغطت على زر جمع تنزل جمع القيم  في صف اجمالي العملاء وهاكذا لو ضيفت عميل6 وعميل 7 وكذلك المورد " عندي عملاء كتير وموردين عملت مثال بسيط للتوضيح "  انا عامل تحويل المعادلة الى قيم

wor1.xlsb

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

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

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

Sub SumThig()
Const str1 As String = "اجمالي العملاء", str2 As String = "اجمالي الموردين"
Dim LR As Long, i As Long, x As Integer, y As Integer
With Sheets("بيانات")
LR = .Range("B" & Rows.Count).End(3).Row
For i = 3 To LR
If .Range("B" & i) = str1 Then
x = i
ElseIf .Range("B" & i) = str2 Then
y = i
End If
Next
.Range("E" & x) = WorksheetFunction.Sum(.Range("E3:E" & x - 1))
.Range("E" & y) = WorksheetFunction.Sum(.Range("E" & x + 1 & ":E" & y - 1))
End With

End Sub

 

[ضياء 2]

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

[محمد هشام.]

 بعد ادن استادنا الكبير ابراهيم الحداد واثراءا للموضوع يمكنك استخدام الكود التالي

Sub SUM_MH()

    Dim LastRow As Long, i As Long, officena As Long, MH As Long
    Application.DisplayAlerts = False
    officena = 1
    With ThisWorkbook.Worksheets("بيانات")
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
    For i = 1 To LastRow
    If .Range("b" & i).Value = "اجمالي العملاء" Or .Range("b" & i).Value = "اجمالي الموردين" Then
      MH = i - 1
   
     .Range("C" & i).Value = Application.Sum(.Range(.Cells(officena, 3), .Cells(MH, 3)))
     .Range("D" & i).Value = Application.Sum(.Range(.Cells(officena, 4), .Cells(MH, 4)))
      .Range("E" & i).Value = Application.Sum(.Range(.Cells(officena, 5), .Cells(MH, 5)))
     
      officena = i + 1
      Application.DisplayAlerts = True

            End If

        Next i

    End With

End Sub

 

.

wor1.xlsm

[ضياء 2]

ما شاء الله استاذنا Mohamed Hicham كود ممتاز هل ممكن إضافة اخر الصف الإجمالي العام هو جمع اجمالي العملاء ، اجمالي الموردين

wor1.xlsm

[محمد هشام.]

تفضل اخي

Sub SUM_MH()
 Dim LastRow As Long, i As Long, officena As Long, MH As Long
 Application.DisplayAlerts = False
 Last = Cells(Rows.Count, "b").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "b").Value) = "الاجمالي العام" Then
Range(Cells(i, "c"), Cells(Rows.Count, 5)).ClearContents
End If
Next i
    officena = 1
    With ThisWorkbook.Worksheets("البيانات")
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    For i = 1 To LastRow
    If .Range("b" & i).Value = "اجمالي الموردين" Or .Range("b" & i).Value = "اجمالي العملاء" Then
      MH = i - 1
     .Range("C" & i).Value = Application.Sum(.Range(.Cells(officena, 3), .Cells(MH, 3)))
     .Range("D" & i).Value = Application.Sum(.Range(.Cells(officena, 4), .Cells(MH, 4)))
     .Range("E" & i).Value = Application.Sum(.Range(.Cells(officena, 5), .Cells(MH, 5)))
     .Range("C" & LastRow) = .Range("C" & LastRow) + .Range("C" & i)
     .Range("D" & LastRow) = .Range("D" & LastRow) + .Range("D" & i)
     .Range("E" & LastRow) = .Range("E" & LastRow) + .Range("E" & i)
      officena = i + 1
      Application.DisplayAlerts = True
            End If
        Next i
    End With
End Sub

wor1-3.xlsm

[ضياء 2]

مبدع ما شاء الله شكرا لكم استاذنا الكريم  Mohamed Hicham هو ده المطلوب وهذا تفضل منكم وسعة صدركم كل الاحترام والتقدير لشخصكم الكريم