كيفية استخراج المكرر في ثلاث اوراق عمل

[mazh]

السلام عليكم،

 

ارجو ايضاح كيفية استخراج المكرر من الاسماء في اكثر من ورقة عمل (Sheet3) ؟ مرفق ملف للتوضيح وهذا مثال فقط

(لان الملف الاصلي يتكون من 20 ورقة وكل ورقة تحمل اكثر من 3000 اسم)

 

وشكرا

Book1.rar

تم تعديل مارس 29, 2015 بواسطه mazh

[mazh]

للرفع

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

اليك الحل

 

repetition in sheets.rar

[mazh]

شكرا جزيلا ويعطيك العافيه

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

الأخ الفاضل mazh

يرجى اختيار المشاركة رقم 3 الخاصة بالأخ الحبيب سليم كأفضل إجابة ..حتى يظهر الموضوع مجاب.

http://www.officena.net/ib/index.php?s=d35cd3c81cab42189452001a0412fe10&showtopic=60147

[رجب جاويش]

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

سلمت يداك أخى الفاضل / سليم

والتحية لأخى وجارى الحبيب / ياسر

 

ولاثراء الموضوع هذا حل عن طريق الكود

 

ويمكن من خلاله ايجاد المكرر فى أى عدد من الصفحات

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

Set sh = Sheets("sheet3")

Sub ragab_Tekrar()
Dim sh As Worksheet
Set sh = Sheets("sheet3")
sh.Range("D4:E10000").ClearContents
LR = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = sh.Range("B4:B" & LR)
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
  If Sheets(i).Name <> sh.Name Then
      LR1 = Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row
      Set Rng1 = Sheets(i).Range("B4:B" & LR)
      For Each cl In Rng
          If Application.WorksheetFunction.CountIf(Rng1, cl) >= 1 Then
                T = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1
                sh.Cells(T, 4) = cl
                sh.Cells(T, 5) = Sheets(i).Name
          End If
     Next
  End If
Next
Set sh = Nothing
Application.ScreenUpdating = True
End Sub

Book11.rar

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

رائع يا استاذي رجب

لكن لدي تعليق 

1- في حال كانت اكثر من صفحة تحتوي على الاسم المحدد  ما العمل

2- اذا كان المقصود ايجاد الاسم مرة واحدة و كي يكون الكود اسرع يجب ان نخرج من دائرة for  مباشرة الى next عبر الامر go to

 

sh.Cells(T, 5) = Sheets(i).Name

go to 1

End If

Next

End If

:1

Next

[ناصر سعيد]

 

اشكركم ايها الكرام

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

رقم تليفونك او ايميلك

[ابو نبأ]

السلام عليكم

 

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