تجميع مجموعة خلايا في حلية واحدة

[lionm]

السادة أعضاء المنتدى الكرام

بعد التحية

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

bb22.rar

[ياسر خليل أبو البراء]

أخي الكريم

ارفق شكل النتائج المتوقعة ليسهل الوصول للحل .. قم بإرفاق بعض النتائج ..

 

 

[سليم حاصبيا]

ربما هذا المطلوب (عودة للتخمين)

bb22 salim.rar

[lionm]

مشكور اخي سليم على الرد واشكر لك جهدك معي

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

 

[lionm]

اخي سليم ارجو الاطلاع على الملف المرفق للتوضيح

ولك جزيل الشكر

bb22.rar

[أبو حنــــين]

مر حبا

جرب الكود التالي

Sub iCopy()

Dim sh As Worksheet, wr As Worksheet, j As Double, R As Double, Ary()
Set sh = Sheets("ورقة1"): Set wr = Sheets("ورقة2")
If wr.Range("a" & Rows.Count).End(xlUp).Row > 1 Then _
wr.Range("A2:E" & wr.Range("a" & Rows.Count).End(xlUp).Row) = ""

    With sh
    LsRow = .Range("a" & Rows.Count).End(xlUp).Row
    For j = 3 To LsRow
    If WorksheetFunction.CountIf(.Range("a3:a" & j), .Range("a" & j)) = 1 Then
    R = R + 1
    ReDim Preserve Ary(1 To 5, 1 To R)
    Ary(1, R) = .Cells(j, 1): Ary(2, R) = .Cells(j, 2): Ary(3, R) = .Cells(j, 4)
    Ary(4, R) = WorksheetFunction.SumIf(.Range("a3:a" & LsRow), Ary(1, R), .Range("E3:E" & LsRow))
    Ary(5, R) = Ary(3, R) * Ary(4, R)
    End If
    Next
    
If R Then wr.Range("A2").Resize(R, 5).Value = WorksheetFunction.Transpose(Ary) 
End With
wr.Select

End Sub

المرفق

 

bb33.rar

[lionm]

مشكور استاذي الفاضل ( ابو حنين ) هذا هو المطلوب بالضبظ جزاك الله خيرا .

 

الشكر موصول لك سيدي ( سليم ) الله يحفظك .

[ياسر خليل أبو البراء]

بارك الله فيك وجزاك الله خيراً أخي وحبيبي في الله أبو حنين

كود رائع ومميز واستخدام مدهش للمصفوفات

 

[أبو حنــــين]

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

و صدقني مازلت أتعثر في المصفوفات نوعا ما و كل مرة اكتشف خطوة

[ياسر خليل أبو البراء]

كلنا نتعثر لست وحدك .. المهم أن ننهض من عثرتنا ونصل لخط النهاية

تقبل وافر تقديري واحترامي

[سليم حاصبيا]

في 9/5/2016 at 23:11, lionm said:

اخي سليم ارجو الاطلاع على الملف المرفق للتوضيح

ولك جزيل الشكر

bb22.rar

تم عمل المطلوب بالمعادلات

AKSSAT.rar

[قلم-الاكسل(عبدالعزيز)]

شكرا على هذه الاكواد والمعادلات من خبرائنا الاعزاء لا حرمنا منكم