كيف أقدر أطلع المكرر في الإكسل

[Abu Al Nour]

السلام عليكم يا إخواني في الله

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

مرفق الملف,

ولكم جزيل الشكر والعرفان,,,

Book2.rar

[يحيى حسين]

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

أخي في الخلية F1 ضع المعادلة التالية :

=SUM(IF(FREQUENCY(IF($A$3:$A$1402<>"",MATCH($A$3:$A$1402,$A$3:$A$1402,0)),ROW($A$3:$A$1402)-ROW($A$3)+1)>1,1))

ثم جرب المعادلة التالية ضعها ففي الخلية D3 ثم أسحبها للأسفل :

=IF(ROW(1:1)<=$F$1,INDEX($A$3:$A$1402,SMALL(IF(FREQUENCY(IF($A$3:$A$1402<>"",MATCH($A$3:$A$1402,$A$3:$A$1402,0)),ROW($A$3:$A$1402)-ROW($A$3)+1)>1,ROW($A$3:$A$1402)-ROW($A$3)+1),ROW(1:1))),"")

و كلاهما معادلات صفيف يجب الضغط على Ctrl +Shift +Enter

يحيى حسين.rar

[Abu Al Nour]

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

أخي في الخلية F1 ضع المعادلة التالية :

=SUM(IF(FREQUENCY(IF($A$3:$A$1402<>"",MATCH($A$3:$A$1402,$A$3:$A$1402,0)),ROW($A$3:$A$1402)-ROW($A$3)+1)>1,1))

ثم جرب المعادلة التالية ضعها ففي الخلية D3 ثم أسحبها للأسفل :

=IF(ROW(1:1)<=$F$1,INDEX($A$3:$A$1402,SMALL(IF(FREQUENCY(IF($A$3:$A$1402<>"",MATCH($A$3:$A$1402,$A$3:$A$1402,0)),ROW($A$3:$A$1402)-ROW($A$3)+1)>1,ROW($A$3:$A$1402)-ROW($A$3)+1),ROW(1:1))),"")

و كلاهما معادلات صفيف يجب الضغط على Ctrl +Shift +Enter

مشكور مشكور مشكور والله ما قصرت يعجز لساني عن شكركم ربنا يجازيكم خير علي الخير اللي بتعملوه ده

[احمد فضيله]

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

بعد إذن الأخ الفاضل الاستاذ الكبير / يحيى حسين

الاخ / Abu Al Nour

تفضل هذا المرفق و ارجو من الله أن يكون هذا طلبك

و للعلم و لاعطاء كل ذي حق حقه هذا الكود من ابداعات الاستاذ الكبير / هشام شلبي .. جزاه الله عنا خير الجزاء

و قمت بتعديلات طفيفه عليه

و الله الموفق والمستعان

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

جلب المكرر HaNcOcK.rar

[يحيى حسين]

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

إضافة لحل الأخ هانكوك جزاه الله كل خير

هذا كود اخر يلبي نفس طلبك

Sub RemoveDuplicate()

Dim c As Range, LR As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("A3:A" & LR)

    If WorksheetFunction.CountIf(Range("A3:A" & c.Row), c.Value) > 1 Then

        i = i + 1

        c.Copy Range("E" & i)

    End If

Next c

End Sub

دمتم في حفظ الله

[Abu Al Nour]

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

بعد إذن الأخ الفاضل الاستاذ الكبير / يحيى حسين

الاخ / Abu Al Nour

تفضل هذا المرفق و ارجو من الله أن يكون هذا طلبك

و للعلم و لاعطاء كل ذي حق حقه هذا الكود من ابداعات الاستاذ الكبير / هشام شلبي .. جزاه الله عنا خير الجزاء

و قمت بتعديلات طفيفه عليه

و الله الموفق والمستعان

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

مشكور يا اخي الفاضل بس ما عرفت ازاي جات

[ياسر الحافظ]

الاخوة / الاساتذة : يحيى حسين + احمد فضيلة :

احيانا احاول ان اتجاوز تقديم الشكر لصاحب العمل ( لكثرة الاعمال والردود المميزة في هذا الموقع الرائد ) الا انني اجد نفسي معجب جدا بهذه الافكار

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

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

شكرا ... شكرا

وفقـــــــــــــــــــــــــــــــــكم الله

ياسر الحافظ " ابو الحارث "

[احمد فضيله]

مشكور يا اخي الفاضل بس ما عرفت ازاي جات

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

بعد إذن الأخ الفاضل الاستاذ الكبير / يحيى حسين

الاخ / Abu Al Nour

تفضل هذا المرفق و ارجو من الله أن يتضح لك الحل من خلاله

فقط قم بالضغط على زرار جلب المكرر لترى ماذا يحدث

و الكود المستخدم هو :

Sub Button1_Click()

On Error Resume Next

Set ww = Application.WorksheetFunction

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Application.ScreenUpdating = False

Range("A2:A" & LastRow).ClearContents

Range(Cells(2, 5), Cells(1000, 5)).ClearContents

For R = 2 To LastRow

       If ww.CountIf(Range("B2:B" & R), Cells(R, 2).Value) > 1 Then

          Cells(1000, 5).End(xlUp).Offset(1, 0) = Cells(R, 2)

          Range(Cells(R, 2), Cells(R, 2)).ClearContents

      End If

Next

Range("B2:O1000").Sort [B2], xlAscending

For N = 2 To LastRow

        If Cells(N, 2) <> "" Then

           Cells(N, 1) = Cells(N, 2).Row - 2

       End If

Next

Application.ScreenUpdating = True

Cells(2, 5).Select

On Error GoTo 0

End Sub

و ستجد هذاالكود في Module1

و يوجد شرح مبسط داخل الملف

و الله الموفق والمستعان

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

جلب المكرر HaNcOcK 2.rar

تم تعديل يوليو 5, 2011 بواسطه HaNcOcK

[الـعيدروس]

سلمت الانامل بارك الله فيكم

استاذ يحيى حسين

و احمد فضيله هانكوك

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

[احمد فضيله]

الاخوة / الاساتذة : يحيى حسين + احمد فضيلة :

احيانا احاول ان اتجاوز تقديم الشكر لصاحب العمل ( لكثرة الاعمال والردود المميزة في هذا الموقع الرائد ) الا انني اجد نفسي معجب جدا بهذه الافكار

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

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

شكرا ... شكرا

وفقـــــــــــــــــــــــــــــــــكم الله

ياسر الحافظ " ابو الحارث "

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

الاخ الحبيب الاستاذ / ياسر الحافظ

كلماتك الطيبة الرقيقة نابعة من شخصك الطيب

بارك الله فيك و جزاك كل خير على مرورك الكريم و دعائك و كلماتك الطيبة

وفقنا الله جميعاً لما يحبه و يرضاه

و الله الموفق والمستعان

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

[احمد فضيله]

سلمت الانامل بارك الله فيكم

استاذ يحيى حسين

و احمد فضيله هانكوك

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

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

الاخ الفاضل / أبو نصار

بارك الله فيك و جزاك كل خير على مرورك الكريم و دعائك و كلماتك الطيبة

و الله الموفق والمستعان

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

[احمد فضيله]

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

الاخ الفاضل / يحيى حسين

بارك الله فيك و جزاك كل خير على مجهودك الكبير

و الله الموفق والمستعان

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

[يحيى حسين]

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

الاخ الفاضل / يحيى حسين

بارك الله فيك و جزاك كل خير على مجهودك الكبير

و الله الموفق والمستعان

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

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

و الحمد لله

[أبو العقاب]

الصراحة

موضوع رائع للغاية

[naderwatfa]

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

هذا ما يميز منتديات أوفيسنا دائماً

[احمد فضيله]

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

الاخ الفاضل / يحيى حسين

بارك الله فيك و جزاك كل خير على مجهودك الكبير

و الله الموفق والمستعان

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

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

و الحمد لله

الحمد لله

[احمد فضيله]

الصراحة

موضوع رائع للغاية

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

الاخ الفاضل / أبو العقاب

بارك الله فيك و جزاك كل خير على مرورك الكريم و كلماتك الطيبة

و الله الموفق والمستعان

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

[احمد فضيله]

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

هذا ما يميز منتديات أوفيسنا دائماً

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

الاخ الفاضل / naderwatfa

بارك الله فيك و جزاك كل خير على مرورك الكريم

و أسأل الله العلي العظيم أن يعلمنا ما ينفعنا و أن ينفعنا بما علمنا

و الله الموفق والمستعان

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

[أبو أنس80]

اشكركم شی جمیل جدا

[يحيى حسين]

ذكريات جميلة منذ عام 2011 

و الذكريات الأجمل و الأقدم منذ عام 2005 

إشتقنا للأخوة الغائبيين الحاضرين بيننا 

[احمد فضيله]

فعلا كانت ذكريات جميله جدا