اضافة في كود الجمع

[نسورالجو]

السلام عليكم الاخوة الكرام بالمنتدى وجدت كود ممتاز لاستاذ Mohamed Hicham كنت ابحث عنه من فترة وجدته بالمنتدى الرائع كنت عاوز اضافة في الكود 

المطلوب جمع اجمالي مخزن الخامات واجمالي مخزن الرئيسي .. الإجمالي الكلي لا يتأثر من اجمالي المخازن كمثال هيكون الإجمالي الكلي هو 17500

Microsoft Excel Worksheet جديد.xlsm

[محمد هشام.]

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

تفضل أخي إستبدل الأكواد الموجودة في الملف  بهذا الكود :

Sub SUM_MH()
Dim lastrow As Long, i As Long, officena As Long, MH As Long
 Application.DisplayAlerts = False
 Call cler_rng
    officena = 1
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
    With ThisWorkbook.Worksheets("رصيد")
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To lastrow
    If .Range("A" & i).Value = "اجمالي مخزن الخامات" Or .Range("A" & i).Value = "اجمالي مخزن الرئيسي" Or .Range("A" & i).Value = "اجمالي مبنى الإنتاج" Then
      MH = i - 1
     .Range("B" & i).Value = Application.Sum(.Range(.Cells(officena, 2), .Cells(MH, 2)))
     .Range("B" & lastrow) = .Range("B" & lastrow) + .Range("B" & i)
      officena = i + 1
            End If
            Next i
            For i = Last To 2 Step -1
If (Cells(i, "A").Value) = "الإجمالي الكلي" Then
 .Range("B" & i).Value = Application.Sum(.Range(.Cells(officena, 2), .Cells(lastrow, 2)))
     .Range("b" & i).Value = .Range("B" & MH) + .Range("B" & MH)
      officena = i + 1
         End If
            Next i
    End With
    Call Sum_Rng_MH
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
End Sub
  Sub Sum_Rng_MH()
    Dim sumRange As Range, criteriaRange As Range
    Dim result As Double
    Dim i As Integer
    Dim lastrow As Long
    Dim R As Range
    Dim criteria As Variant
    Set sumRange = Range("B3:B1000")
    Set criteriaRange = Range("A3:A1000")
    criteria = Array("اجمالي مخزن الخامات", "اجمالي مخزن الرئيسي")
    For i = 0 To UBound(criteria)
        result = WorksheetFunction.Sum(result, _
                WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria(i)))
    Next i
Set R = ActiveSheet.Cells.Find("اجمالي المخازن", , xlValues, xlWhole)
If Not R Is Nothing Then R.Select
ActiveCell.Offset(0, 1).Select
  ActiveCell.Value = result
  Range("a2").Activate
End Sub

Sub cler_rng()
Application.ScreenUpdating = False
Dim searches As String
searches = "اجمالي مخزن الخامات|اجمالي المخازن|اجمالي مخزن الرئيسي|اجمالي مبنى الإنتاج|الإجمالي الكلي"
Dim listOfSearches() As String
listOfSearches = Split(searches, "|")
Dim i As Integer
For i = 0 To UBound(listOfSearches)
    Set R = ActiveSheet.Cells.Find(listOfSearches(i), , xlValues, xlWhole)
    If Not R Is Nothing Then
        R.Offset(0, 1).Value = ""
    Else
        ActiveCell.Offset(0, 1).Value = ""
    End If
Next i
Application.ScreenUpdating = True
End Sub

 

Worksheet جديد.xlsm

[نسورالجو]

السلام عليكم الاخوة الافاضل بالمنتدى فضلا من كرمكم في تعديل بسيط للكود الرائع لاستاذ Mohamed Hicham " مشكلة عند كتابة التاريخ في خلية ( B1 ) يجمع التاريخ + مخزن الخامات1+ مخزن الخامات2 في اجمالي مخزن الخامات  - المطلوب عند كتابة التاريخ في خلية ( B1 ) لا يتاثر اجمالي مخزن الخامات "

انتيه من فضلك بأن يكون الطلب من أول مرة وبدون أى تعديل  ومن واقع الملف الأصلى ..تجنباً لإهدار وقت الأساتذة !!

Worksh.xlsm

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته  ..تفضل اخي 

Worksh.xlsm

[نسورالجو]

انا عاجز عن شكر حضرتك استادنا الفاضل Mohamed Hicham بارك الله في علمك وصحتك وجزاك الله خيرا