نقل الاسماء المكررة مرة واحدة فقط

[Elsayeh]

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

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

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

الملف في المرفقات 

مع خالص تحياتي

ترحيل بيانات الاسماء المكررة.xlsx

[lionheart]

The name in cell C10 should have a space between the first name and last name so as to be identical as the name in cell C5

Sub Test()
    Dim a, txt As String, i As Long, ii As Long
    a = Range("C5:G" & Cells(Rows.Count, "C").End(xlUp).Row).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            txt = a(i, 1)
            If Not .Exists(txt) Then
                .Item(txt) = .Count + 1
                For ii = 1 To UBound(a, 2)
                    a(.Count, ii) = a(i, ii)
                Next ii
            Else
                For ii = 2 To UBound(a, 2)
                    a(.Item(txt), ii) = a(.Item(txt), ii) + a(i, ii)
                Next ii
            End If
        Next i
        i = .Count
    End With
    [J6].Resize(i, UBound(a, 2)) = a
End Sub

 

[Elsayeh]

أخي الكريم 

الكود يعمل بكفاءة لكني أحتاج تعديل حيث أن بعض الخانات بها بيانات نصية وهو يجمعها فتكون مكررة

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

ترحيل بيانات الاسماء المكررة.xlsm

[lionheart]

I work on just only one file. Try to study the code and modify it by yourself

[Elsayeh]

السلام عليكم اخي الفاضل حاولت تعديل الكود لكني فشلت الرجاء تعديله 

وفي ميزان حسناتك ان شاء الله 

ترحيل بيانات الاسماء المكررة.xlsm

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

@Elsayeh

اعتقد  ان @lionheart  قام  باجابتك  فهل  يعقل  بعد  الاجابة  تقوم  بازالة  علامة  الاجابة  وتطلب  تعديل  جديد .😱

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

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

واعتقد  ان @lionheart اعطاك كود قوي  وسريع 😎

[Elsayeh]

عذرا أخي الكريم

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

@lionheart after you 

نظرة  سريعة  على  الكود  جرب  تغيير هذا  السطر من 

                For ii = 2 To UBound(a, 2)

الى

                For ii = 2 To UBound(a, 2)-2

اذا  لم  ينجح   اصدر  موضوع  جديد

ملاحظة :  كما  قال  لك @lionheart  قم  بتعديل  المسافات  للاسماء  المتكررة  حتى  يعمل  الكود   حتى  لا تاتي  بعد  فترة   وتقول  الكود  لم  يعد  يعمل 

تحياتي

[Elsayeh]

أخي @عبدالفتاح في بي اكسيل لك جزيل الشكر على هذا الحل السريع والناجز 

[محمد حسن المحمد]

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

بعد إذن أساتذتي الكرام ، بعد الاطلاع على ملف الأخ @Elsayeh 

فإنني أقترح عليه نقل ملحقات الاسم (المرحلة - الشعبة) إلى جواره كي لا تتكرر أو تجمع بعدد مرات تكرار الاسم ، كما أنني لاحظت أنه زاد مواد أخرى فهو قد يكون بحاجة لتعديل الملف على الشكل التالي:

   

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

عذراً على التدخل ولكن أحببت أن أذكر وجهة نظري...

والسلام عليكم

ترحيل بيانات الاسماء المكررة.xlsm

[Elsayeh]

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

[محمد حسن المحمد]

منذ ساعه, Elsayeh said:

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

ولكم بمثل ما دعوتم أخي الحبيب

جزاكم الله خيرا وأحسن إليكم آمين