هل يمكن تحويل هذة المعادلات إلى كود

[نادر سليم]

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

إلى أساتذة المنتدى الكرام

فى المرفق معادلات للدالة Sumifs

هلى يمكن تحويلها الى كود وذلك لكثرة البيانات التى تحققها هذة الدالة والتى قد يصل مدخلاتها الى 50000 حركة ونتائجها تستخلص ل 4000 صنف

 ويعجز لسانى عن الشكر لكل اعضاء وأساتذة المنتدى الكرام

 

11.rar

[طارق محمود]

السلام عليكم

أخي الكريم
جرب هذا الكود

Sub ConvertFunction()
Dim H, B, C, J, K, M As Range
With Sheet1
    Set H = .Range("H:H"):      Set B = .Range("B:B")
    Set C = .Range("C:C"):     Set J = .Range("J:J")
    Set K = .Range("K:K"):      Set M = .Range("M:M")
End With
LR = [B65536].End(xlUp).Row
If LR <= 5 Then MsgBox "No data to retreive": Exit Sub


For r = 5 To LR
        cl = Cells(r, 2)
        cr1 = ">=" & [C1]:          cr2 = "<=" & [C2]
        cr3 = ">=" & [G1]:          cr4 = "<=" & [G2]


        Cells(r, 3) = WorksheetFunction.SumIfs(H, B, cl, C, cr1, C, cr2)
        Cells(r, 4) = WorksheetFunction.SumIfs(J, B, cl, C, cr1, C, cr2)
        Cells(r, 6) = WorksheetFunction.SumIfs(K, B, cl, C, cr1, C, cr3)
        Cells(r, 7) = WorksheetFunction.SumIfs(M, B, cl, C, cr1, C, cr4)
Next
End Sub

تفضل المرفق وبه الكود

 

11_New.rar

[نادر سليم]

أستاذ  طارق محمود

ألف ألف شكر على سرعة الرد

ولا أروع من هذا الحل  وهو المطلوب فعلاً

جزاك الله عنا كل خير وجعلة فى ميزان حسناتك

[نادر سليم]

أستاذ  طارق محمود

ألف ألف شكر على سرعة الرد

ولا أروع من هذا الحل  وهو المطلوب فعلاً

جزاك الله عنا كل خير وجعلة فى ميزان حسناتك

 الحل جميل ولكن يوجد مشكله لا أعرف حلها وهى ان الشرط المراد البحث عنة وهو بين تاريخين محددين لم يتحقق

كما فى المرفق  مثلاً الصنف1 اردت البحث بين تاريخين لتجميع النتائج ولكنها لم تظهر بشكل صحيح ظهر تجميع الفترة بالكامل

ولك منى جزيل الشكر

[نادر سليم]

المرفق

11_New.rar

[نادر سليم]

الى الاستاذ طارق

اسمح لى بأننى أضفت تعديل بسيط فى الكود لكى يعمل بالصورة المطلوبة

Sub ConvertFunction()

Dim H, B, C, J, K, M As Range

With Sheet1

Set H = .Range("H:H"): Set B = .Range("B:B")

Set C = .Range("C:C"): Set J = .Range("J:J")

Set K = .Range("K:K"): Set M = .Range("M:M")

End With

LR = [b65536].End(xlUp).Row

If LR <= 5 Then MsgBox "No data to retreive": Exit Sub

For r = 5 To LR

cl = Cells(r, 2)

cr1 = [">="&C1]: cr2 = ["<="&C2]

cr3 = [">="&G1]: cr4 = ["<="&G2]

Cells(r, 3) = WorksheetFunction.SumIfs(H, B, cl, C, cr1, C, cr2)

Cells(r, 4) = WorksheetFunction.SumIfs(J, B, cl, C, cr1, C, cr2)

Cells(r, 6) = WorksheetFunction.SumIfs(K, B, cl, C, cr1, C, cr4)

Cells(r, 7) = WorksheetFunction.SumIfs(M, B, cl, C, cr1, C, cr4)

Next

End Sub

[نادر سليم]

هذا هو المرفق بعد التعديل لتعم الفائدة

وشكراً جزيلا ل أستاذ طارق

وشكراً لكل أساتذة المنتدى الذين اضافو النور الى طريقنا

11_New.rar