تجميع الاسماء

[ضياء الدين (أبو أنس)]

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

الاخوة الافاضل رواد المنتدى العظيم ( بجد والله باستفيد كتير منكم ) 

الملف المرفق عبارة عن شيت لاسماء اولياء امور الطلاب في الروضة ومدفوعاتهم 

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

حاجة كده اشبه بتكويد الاسماء ....

يعني مثلا اخر اسم في اولياء الامور لو هو هيتكرر لانه هيسدد على كذا مرة اقدر اعرف مجموعه كم ازاي ؟؟؟؟؟؟؟؟

دمتم بخير ...

ايرادات KG.rar

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

أخي الكريم

يرجى وضع تصور لشكل النتائج المتوقعة لتجد الحل المناسب بشكل أسرع

تقبل تحياتي

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

إليك أخي الفاضل الملف التالي عله يكون المطلوب

تم عمل ورقة تقرير ..اختار الاسم ثم انقر زر الأمر لتظهر البيانات المرتبطة بهذا الاسم

Sub Report()
    Dim WS As Worksheet, SH As Worksheet
    Dim I As Long, lRow As Long, LR As Long
    Set WS = Sheets("نور البيان "): Set SH = Sheets("Report")
    lRow = 6

    Application.ScreenUpdating = False
        With SH.Range("D6:K1000")
            .ClearContents: .Interior.Color = xlNone
        End With
        Call UniqueNames
        For I = 7 To 506
            If WS.Cells(I, "C") = SH.Cells(3, "C") Then
                WS.Cells(I, "C").Offset(, 1).Resize(1, 8).Copy
                SH.Cells(lRow, "D").PasteSpecial xlPasteValues
                lRow = lRow + 1
            End If
        Next I
        SH.Range("D7:H1000").ClearContents
        LR = SH.Cells(Rows.Count, "I").End(xlUp).Row + 1
        With SH.Range("I" & LR)
            .Formula = "=SUM(I6:I" & LR - 1 & ")": .Value = .Value: .Interior.Color = 10092441
            If .Value = SH.Range("H6") Then
                MsgBox "تم سداد المبلغ بالكامل", 64
            Else
                MsgBox "المبلغ لم يتم سداده بالكامل ما زال هناك أقساط متبقية", vbExclamation
            End If
        End With
        SH.Range("C3").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Sub UniqueNames()
    Dim Rng As Range
    Dim Dn As Range
    Dim Dic As Object
    With Sheets("نور البيان ")
        Set Rng = .Range("C7:C506")
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    For Each Dn In Rng
        If Not IsEmpty(Dn) Then Dic(Dn.Value) = Empty
    Next Dn
    Sheets("Report").Columns(15).ClearContents
    Sheets("Report").Range("O1").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.keys)
End Sub

 

Report Summary.rar

[خالد الرشيدى]

استاذى الحبيب ياسر

اسمح لى ان اقدم مشاركة لاثراء الموضوع ... بإستخدام المعادلات

اخى الكريم الملف المرفق قائم على فكرة اضافة  قيمة الدفعة ليظهر اجمالى الدفعات المسددة والمبلغ المتبقى تلقائى

 ايرادات KG.rar

 

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

بارك الله فيك أيها المتمكن خالد

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

وخصوصاً الدالة INDIRECT ..كأنها سحر المعادلات

[خالد الرشيدى]

       اخى واستاذى الحبيب  ابو البراء

 كلام حضرتك شرف كبير لى  ....  جزاك الله خيراً

      خالص حبى وتقديرى لشخصكم الكريم

[الشهابي]

أخي العزيزالأستاذ / خالد الرشيدي

جزاك الله خير 

وكما أشار استاذن الكبير / ياسر خليل 

أسلوبك في المعادلات رهيب 

فعلا فقد لاحظت ذلك في بعض ردودك زادك الله علما ورفعة 

أحببت أن استفسر حول استخدام دالة ( INDIRECT ) مع دالة ( SUMIF ) 

لماذا لم تستخدم نفس المدى الذي استخدمته مع دالة (COUNTIF) وهو: 

$C$7:C7

فاظنه يعطي نفس النتيجة  

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

=IF(COUNTIF(C$7:C7;C7)>1;SUMIF($C$7:C7;C7;$I$7:$I$489);I7)

هذا والله أعلم

بارك الله فيكم الأستاذ العزيز / خالد الرشيدي وجزاكم الله خير 

ومنتظرين المزيد من إبدعاتكم 

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

والعفو

[ابو نبأ]

السلام عليكم

روعة استاذ ياسر ابو براء - زادتكم الله علما

 

[خالد الرشيدى]

استاذى الحبيب / الشهابى

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

 عمل رائع استاذنا الفاضل .. جزاك الله خيراً

خالص تقديرى واحترامى لشخصكم الكريم

[الشهابي]

جزاكم الله خير الأستاذ العزيز / خالد الرشيدي

على صدركم الرحب وأخلاقكم الرائعة 

أم التعديل أجده أمر عادي ربما مجرد سهو منكم وإلا فأنتم أجدر بما هو أكبر من ذلك

بارك الله فيكم ورفع قدركم

[ضياء الدين (أبو أنس)]

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

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

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

كل عام وانتم بخير وطاعة

اتابع الردود واوافيكم ان شاء الله

[ضياء الدين (أبو أنس)]

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

وأسال الله تعالى ان ينفعني بعلمكم

هل من الممكن دمج هذين العملين الرائعين في ملف واحد  ؟؟؟؟؟؟؟

ملف الاستاذ القدير / ابو البراء

و

ملف الاستاذ البارع / الرشيدي

 

[ضياء الدين (أبو أنس)]

استاذى الحبيب ياسر

اسمح لى ان اقدم مشاركة لاثراء الموضوع ... بإستخدام المعادلات

اخى الكريم الملف المرفق قائم على فكرة اضافة  قيمة الدفعة ليظهر اجمالى الدفعات المسددة والمبلغ المتبقى تلقائى

 ايرادات KG.rar

 

استاذي العزيز الغالي

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

(يعني مثلا : انس ضياء الدين محمد مصطفى دفع القسط الاول  1000 من اصل المبلغ 1750 الباقي 750

لما اجي اكتب الاسم مرة تانية تطلع القيمة المستحقة اللي هي 750 تلقائيا )

ينفع ولا ؟؟؟؟

 

ايرادات.rar