تحويل دالة SUMPRODUCT الى كود VBA

[zxzxzxz]

السلام عليكم

لدي معادلة تعمل بشكل صحيح

واريد تحويلها الى كود VBA

هل هذا ممكن

اريد تطبيق هذه المعادلة على الخلايا من E2 الى E100

=SUMPRODUCT((DATA!B:B<$A2)*(DATA!M:M="MOHAMMED")*(DATA!A:A=$B2)*(DATA!W:W))

تحياتي لكم

تم تعديل يوليو 14, 2010 بواسطه zxzxzxz

[zxzxzxz]

[عبد الفتاح كيرة]

أرفق ملفا أخى

[zxzxzxz]

السلام عليكم

مرفق مثال لكم

Test.zip

[عبد الفتاح كيرة]

Sub testo()

Sheets("result").Select

Range("e2:e100").Formula = "=SUMPRODUCT((DATA!B:B<A2)*(DATA!M:M=$h$1)*(DATA!A:A=B2)*(DATA!W:W))"


End Sub

الخلية h1 فى الشيت result

بها القيمة

MOHAMMED

تم تعديل يوليو 16, 2010 بواسطه kemas

[zxzxzxz]

اخي kemas

ياليت تطبقها على الملف المرفق اعلاه

لاني حاولت واعطاني رسالة ارررررور

تحياتي

[عبدالله باقشير]

السلام عليكم

اضافة الى كود الاخ Kemas

بارك الله فيه

والذي ممكن تعدل فيه ليشمل نطاق الخلايا الماخوذ من الورقة DATA

صفوف معينة مثلا من 1:1500

Sub testo()

Sheets("result").Select

Range("e2:e100").Formula = "=SUMPRODUCT((DATA!B1:B1500<A2)*(DATA!M1:M1500=$h$1)*(DATA!A1:A1500=B2)*(DATA!W1:W1500))"

Range("e2:e100").Cells = Range("e2:e100").Value

End Sub

==================================== طريقة اخرى الاسم MYRNG هو نطاق الخلايا DATA!A1:W1500

Sub kh_Evaluate()

Dim Rng As Range, N As Range

Set Rng = Sheets("Result").Range("E2:E100")

Rng.ClearContents

For Each N In Rng

    N = Application.Evaluate("SUMPRODUCT((INDEX(MYRNG,0,13)=" & Range("H1").Address & ")*(INDEX(MYRNG,0,1)=" & Cells(N.Row, 2).Address & ")*(INDEX(MYRNG,0,2)<" & Cells(N.Row, 1).Address & ")*INDEX(MYRNG,0,23))")

Next

End Sub

===================================== طريقة اخرى بدون استخدام الدالة SUMPRODUCT بالكود مباشرة:

Option Explicit


Sub Kh_SumRange()

Dim i As Integer

Range("E2:E100").ClearContents

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

With Sheets("Result")

    For i = 2 To 100

        .Cells(i, "E") = Kh_Sum(.Cells(i, "A"), .Cells(i, "B"))

    Next i

End With

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub


---------------------------------------

Function Kh_Sum(Colmn_A As Range, Colmn_B As Range)

Dim Z As Double

Dim R As Long, Last As Long

With Sheets("DATA")

    Last = .Range("A" & .Rows.Count).End(xlUp).Row

    For R = 1 To Last

        If .Cells(R, "M") = "MOHAMMED" Then

            If .Cells(R, "A") = Colmn_B Then

                If .Cells(R, "B") < Colmn_A Then

                    Z = Z + .Cells(R, "W")

                End If

            End If

        End If

    Next R

End With

Kh_Sum = Z

End Function

شاهد المرفق

خبور خير

تحويل معادلة الى كود.rar

[عبد الفتاح كيرة]

تفضل

اضغط زر الأمر

وانتظر قليلا

لأن البيانات كثيرة

Test--kemas.zip

[عبد الفتاح كيرة]

معذرة

يبدو أننا و الأستاذ خبور كتبنا بوقت واحد

لعل هذا من الفأل الحسن

الأستاذ خبور فى رد واحد

قدم لنا كتابا

نذاكر فيه إن شاء الله بقية الصيف

و مع هذه المذاكرة فالنتائج غير مضمونة

زادك الله علما

مؤقتا

وكدفعة بسيطة لتلميذك

ما فائدة هذا السطر المزيد على الكود الذى قدمته للأخ

Range("e2:e100").Cells = Range("e2:e100").Value

جزاك الله خيرا

[عبدالله باقشير]

السلام عليكم

بارك الله فيك اخي Kemas

ما فائدة هذا السطر المزيد على الكود الذى قدمته للأخ

Range("e2:e100").Cells = Range("e2:e100").Value

جزاك الله خيرا

هذا لتحويل الصيغة الى قيمة

يعني نستغني عن وجود الصيغة لتخفيف حجم الملف

خبور خير

[عبد الفتاح كيرة]

جزيت خيرا أستاذنا

[zxzxzxz]

تحت التجربة ....

تم تعديل يوليو 18, 2010 بواسطه zxzxzxz

[zxzxzxz]

اخي خبور خير

واخي kemas

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

وهي حجم البيانات التي استخدمها

صراحة اريد تطبيق الكود على الخلايا e2:e54000

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

Run-time error 6

Overflow

وانا اريد تطبيق معادلة VBA بدلا من دالة الاكسل حتى اسرع عملية الحساب ... ولكن تفاجاة برسالة الاررروررر

هل هناك حل اخر او اضافة على الاكود اعلاه ؟ وهل هناك عملية تحسب المعادلة بشكل اسرع مع حجم هذه البيانات؟

تحياتي للجميع

[عبدالله باقشير]

السلام عليكم

صراحة اريد تطبيق الكود على الخلايا e2:e54000

اي كود او معادلة ستتعامل مع 54000 صف

وبالشروط التي تريدها

اكيد ستاخذ الكثير من الوقت

ايه الداعي لحساب هذه الكم في آن واحد ؟؟

بامكانك تحجيم ما تريده حسب طلبك

خبور خير

[DR.ZUHAIR]

السلام عليكم ماشاء الله عليكم حلول اكثر من رائعة

لكن استاذي الفاضل خبور خير هل إذا اردنا استخراج النتائج من ورقة DATA للجميع وليس MOHAMMED فقط فهل هذه المسألة صعبة أومعقدة،،،، يعني التجميع على

حسب كل اسم وكما هو موجود بالجدول تماماً قرين كل منتج واسمه وتاريخ انتاجه،،، ياريت تتفضلوا بالحل اكون ممون لكم جداً جداً

[zxzxzxz]

هلا فيك اخي خبور خير

صراحة واقع بالمشكلة هذه لي شهر...

البيانات عارف ان حجمها كبير جدا

لكن ماذا تقترح؟

هل تعتقد ان الاكسس راح يكون اسرع من الاكسل بمعالجة هذا النوع من البيانات؟

تحياتي لك

[عبد الفتاح كيرة]

هلا فيك اخي خبور خير

صراحة واقع بالمشكلة هذه لي شهر...

البيانات عارف ان حجمها كبير جدا

لكن ماذا تقترح؟

هل تعتقد ان الاكسس راح يكون اسرع من الاكسل بمعالجة هذا النوع من البيانات؟

تحياتي لك

نعم