طلب مساعدة في اختزال الصفوف المتكررة

[Abo_M7mad]

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

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

ايامكم ان شاء الله مباركة وعامرة بالاجر والمغفرة والمثوبة

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

لدي مصنف فيه ورقة عمل تحتوي على بيانات متكررة "6057 صف" (كما في الصورة القسم الايمن لدينا بيانات متكررة في عدة صفوف)

اريد طريقة لاختزال تكرار الصفوف الى صف واحد فقط يوضح عدد مرات التكرار بغض النظر عن كون النتيجة ناجح او راسب مايهمني فقط هو عدد مرات التكرار (القسم الايسر من الصورة)

ارجو مساعدتي عاجلا لاجل انهاء بعض العمل العالق ، ولكم جزيل الشكر

[هشام شلبى]

السلام عليكم

===========

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

شاهد المرفق

ايجاد المكرر وعدد مرات التكرار.rar

[Abo_M7mad]

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

اخي الفاضل هشام

فعلا ردك هو ما ابحث عنه ، ولكن ارشدني الى تطبيقه لدي

عذرا لجهلي بالطريقة مع اني اعشق هذا البرنامج ولكني لست محترفا فيه .

شكرا لك

[Abo_M7mad]

استاذي الفاضل

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

وعلى كل حال ارجو ان توضح لي الطريقة لاني مهتم بمعرفتها ان شاء الله

شكرا لك

[هشام شلبى]

السلام عليكم

==========

اخى العزيز

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

ارفق ملفك اطبق عليه واوافيك بشرح الطريقة ان شاء الله

[Abo_M7mad]

السلام عليكم

اسعد الله مسائك اخي الكريم

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

حسنا ، قمت بإدارج نفس الملف الذي لدي .

اشكر لك وقتك وجهد وبارك الله لك في علمك وزادك من فضله .

شكرا لك

اسماء وارقام مكررة.rar

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

السلام عليكم

بارك الله فيك اخي هشام

ولاثراء الموضوع

حل آخر بالكود التالي:

Sub kh_Filter()

Dim Col As Range, Rng As Range

Dim Last As Long


Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual


Last = Range("A65536").End(xlUp).Row


Range("F2:F" & Last).ClearContents

Set Rng = Range("A1:B" & Last)

Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1:E1"), Unique:=True


Last = Range("D65536").End(xlUp).Row


    For Each Col In Range("F2:F" & Last)

        Col.Value = Application.CountIf(Rng.Columns(1), Cells(Col.Row, "D"))

    Next


Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

Set Rng = Nothing

End Sub

خبور خير

اسماء وارقام مكررة.rar

[هشام شلبى]

السلام عليكم

===========

اللهم بلغ اخى خبور رمضان

واعطة من عطاياك المباركة فى ليلة القدر

ولمزيد من الافادة

هنا حل اخر بالمعادلات

اسماء وارقام مكررة1.rar

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

السلام عليكم

اللهم بلغ اخى خبور رمضان

واعطة من عطاياك المباركة فى ليلة القدر

ولك بمثل دعائك اضعاف مضاعفة

اكرمك الله في الدارين

تقبل تحياتي وشكري

[Abo_M7mad]

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

بارك الله فيكم اخواني الافاضل على هذا الجهد

اشكر لكم حسن صنيعكم والله لا يضيع اجر المحسنين

جاري التحميل والاطلاع ان شاء الله