كيف يمكن استخدام sumproduct فى vba

[hsa100]

السلام عليكم

كيف يمكن استخدام sumproduct فى vba

Application.WorksheetFunction.SumProduct(Range("a5:a30") = Range("E6")) * (Range("b5:b30") = Range("F5")) * (Range("c5:c30"))

حيث يوجد (error ( type mismatch

واشكر لكم اهتمامكم

test1 sumproduct.rar

[hsa100]

up

[hsa100]

up

[زياد علي]

السلام عليكم

اخي الحبيب

لا ادري إن كان هذا الحل يناسبك

بالمرفق مقترحين للحل

أنا شخصياً اعمل بالطريقة الثانية

وقد يقوم الاخوة المشرفين الأفاضل بالمساعدة

وهذا ايضَا ًرابط قريب جداً من موضوع سؤالك لاستاذنا الفاضل علي السحيب :

http://www.officena.net/ib/index.php?showtopic=14318&view=&hl=كيف نكتب معادله في sheet code عند استعمالنا sumpr &fromsearch=1

تحياتي اخي العزيز

test1.1 sumproduct.rar

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

السلام عليكم

الله يبارك فيك اخي زيد

انا استخدم الطريقة الثانية مثل ما تفضلت حضرتك

ولكن بالكود التالي:

Sub kh_Formula()

With Range("F6:G8")

    .ClearContents

    .Formula = "=SUMPRODUCT((R5C1:R30C1=RC5)*(R5C2:R30C2=R5C),R5C3:R30C3)"

    .Value = .Value

End With

End Sub

اختصارا لوجع القلب بتاع معادلة SUMPRODUCT

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

الحل:

اذا نستخدمها كمعادلة مع تعميمها على كل الخلايا المراد وضعها فيها

ثم نحول المعادلات الى قيم

[زياد علي]

السلام عليكم

اخي خبور خير

منور وكل عام وانت بألف صحة وخير يارب

كلام صح ومية مية واعتقد ان الاخ السائل هذا هو طلبه بالتمام

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

إذن :

.Value = .Value

هي تعني تحويل المعادلة إلى قيم ،، فعلاً معلومة قيمة

جزاك الله خير

محتاجين شحنة ايمانية جديدة اخي كشحنة تلك الليلة!!

وفقك الله

test1.2 sumproduct.rar

تم تعديل نوفمبر 22, 2009 بواسطه ziad ali

[hsa100]

اخوانى الكرام خبور خير ، ziad ali

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

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

حيث ان عدد المعادلات فى الملف الخاص بى سيصل الى 39420 معادلة مما سيؤدى الى بطء شديد عند تغيير اى من القيم المرتبطة بالمعادلات

اخوانى الكرام

هل يمكن تنفيذ ذلك من خلال الكود Application.WorksheetFunction.SumProduct دون ان تظهر رسالة الخطأ type mismatch

وايهما اسرع فى التنفيذ

طريقة الكود Application.WorksheetFunction.SumProduct

ام طريقة المعادلات .Formula = "=SUMPRODUCT((R5C1:R30C1=RC5)*(R5C2:R30C2=R5C),R5C3:R30C3)"

واشكر لكما اهتمامكما مرة اخرى.

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

السلام عليكم

هل يمكن تنفيذ ذلك من خلال الكود Application.WorksheetFunction.SumProduct دون ان تظهر رسالة الخطأ type mismatch

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

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

شاهد مثلا الكود التالي:

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

Sub PopulateCrossTab()

'Count ocurences of Colour and Price Code _

combinations in database

Dim Field_ColourData As Variant

Dim Field_PriceCodeData As Variant

Dim CrosstabRowHeader As Variant

Dim CrosstabColHeader As Variant

Dim TestArray1() As Long

Dim TestArray2() As Long

Dim TableArray() As Variant


'Load arrays

Field_ColourData = Range("Colour")

Field_PriceCodeData = Range("PriceCode")

CrosstabRowHeader = _

Range("Crosstab").Resize(, 1).Offset(, -1)

CrosstabColHeader = _

Range("Crosstab").Resize(1).Offset(-1)



x = UBound(CrosstabColHeader, 2)

y = UBound(CrosstabRowHeader, 1)

Records = UBound(Field_ColourData, 1)


ReDim TestArray1(1 To Records)

ReDim TestArray2(1 To Records)

ReDim TableArray(1 To y, 1 To x)


For r = 1 To y

For c = 1 To x

'Build test arrays for sumproduct

For i = 1 To Records

TestArray1(i) = _

Field_ColourData(i, 1) = CrosstabColHeader(1, c)

TestArray2(i) = _

Field_PriceCodeData(i, 1) = CrosstabRowHeader(r, 1)

Next

TableArray(r, c) = _

WorksheetFunction.SumProduct(TestArray1, TestArray2)

Next

Next


Range("Crosstab") = TableArray


End Sub

واخترت لك حلين مبسطين :(بالمرفق)

Sub kh_Test()

Dim Rng As Range, N As Range

Dim WS As Worksheet

Set WS = ورقة1

Set Rng = WS.Range("F6:G10")

Rng.ClearContents

For Each N In Rng

    N = Application.Evaluate("SUMPRODUCT((offices=" & WS.Cells(N.Row, 5).Address & ")*(asnaf = " & WS.Cells(5, N.Column).Address & ")*(totals))")

Next

End Sub

والثاني:

Sub kh_Test_1()

Dim WS As Worksheet

Dim Rng As Range, N As Range

Dim kh_1, kh_2

Set WS = ورقة1

Set Rng = WS.Range("F6:G10")

Rng.ClearContents

For Each N In Rng

    kh_1 = WS.Cells(N.Row, 5)

    kh_2 = WS.Cells(5, N.Column)

    N = Application.Evaluate("SUMPRODUCT((offices=""" & kh_1 & """)*(asnaf = """ & kh_2 & """)*(totals))")

Next

End Sub

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

وهو من اسهل الحلول ولا يحتاج تنفيذه الى وقت طويل

شاهد المرفق

test1.2 sumproduct.rar

[hsa100]

اخى الكريم

مش عارف اقولك ايه .. تسلم ايدك

حقيقى .. انت مبدع وفنان

متشكر جدا لاهتمامك

[زياد علي]

السلام عليكم

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

يا معلم يا كبير

فعلاً حل يعد ابسط كثيراً وافضل من الحلول التي تعرض في المنتديات الاجنبية

فهنيئاً لنا بك ،،، وهذا الحل اعتبره مرجع هام بالنسبة لي لاستخدام هذه الدالة

إذ أنه بالاستخدام العادي للمعادلة فإن وقت الاحتساب يأخذ الوقت الطويل

وهذا ما يضطرنا للعمل بالكود

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

وكل عام وانت اسرتك الكريمة بألف ألف خير