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

[محي الدين ابو البشر]

السلام عليكم

في الشيت الاول والثاني لدينا مجموعة أسماء الاسماء قد تكون مكررة في الشيت الواحد أو في الشيت الثاني

المطلوب بعد اذنكم بمعالات تجميع الأسماء في الشيت 3 بدون تكرار

في المرفق الاسماء موجودة في الشيت 1والشيت 2

في الشيت 3 النتائج المتوقعة

جزاكم الله كل خير

Book1.rar

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

أخي الحبيب محي الدين mohadin ...

إليك الكود التالي عله يفي بالغرض

Sub UniqueListFromMultipleSheets()
    Dim X, Y(), I&, J&, K&, WS As Worksheet
    ReDim Y(1 To Rows.Count, 1 To 1)
    
    With CreateObject("Scripting.Dictionary")
    
        .CompareMode = 1
        
        For Each WS In ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2"))
            X = WS.Range("A1:A" & WS.Cells(Rows.Count, 1).End(xlUp).Row).Value
            For I = 1 To UBound(X)
                If Len(X(I, 1)) Then
                    If Not .Exists(X(I, 1)) Then
                        J = J + 1
                        .Item(X(I, 1)) = J
                        Y(J, 1) = X(I, 1)
                    End If
                End If
            Next I
        Next WS
        
    End With

    With Sheets("Sheet3")
        .UsedRange.ClearContents
        .Range("A1").Resize(J, 1).Value = Y()
    End With
End Sub

تقبل تحياتي

 

[أبوبسمله]

اخى الفاضل

جزاك الله كل خير يا ابوالبراء لم ارى مشاركتك الا بعد الاضافه بحب اكوادك 

يالا بقا زيادة الخير

فى خاصيه جميله اسمها تصفيه متقدمه فى ٢٠٠٣ فى تبويب بيانات وفى ٢٠٠٧ وطالع تبويب بيانات اسمها خيارات متقدمه 

حدد عمود الاسماء واختار التصفيه المتقدمه ثم حدد النسخ لموقع اخر وحدد المكان اللى هتنسخ فيه هتلاقى الاسماء من غير تكرار

طبعا لوحابب معادلات هتلاقى كل شىء باذن الله

تم تعديل مارس 10, 2016 بواسطه أحمد الفلاحجى

[محي الدين ابو البشر]

السلام عليكم

استاذ ياسر

ولا أجمل

جزاك الله خيراً كثيرا حتى ترضى

 

السلام عليكم

استاذ احمد

حاولت في الطريقة ولكن لم أنجح بتحديد الأسماء في شيتين من شيت واحدة الامور تمام ولكن من شيت 1 وسيت2 لم تنجح معي

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

وعليكم السلام أخي الحبيب محي الدين

الأجمل هو تواجدك معنا بالمنتدى .. بارك الله فيك وجزيت خيراً على تدخلاتك في الموضوعات المختلفة لمساعدة إخوانك بالمنتدى

تقبل تحياتي

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

بهد اذن اخي ياسر 

جرب هذا الملف بواسطة هذا الكود

Sub tarhil_unique_items()

Dim Sh1, Sh2, Sh3 As Worksheet
Dim lr1, lr2, lr3, k As Integer
k = 1

Set Sh1 = Sheets("sheet1"): Set Sh2 = Sheets("sheet2"): Set Sh3 = Sheets("sheet3")
    lr1 = Sh1.Cells(Rows.Count, 1).End(3).Row
    lr2 = Sh2.Cells(Rows.Count, 1).End(3).Row
    lr3 = Sh3.Cells(Rows.Count, 1).End(3).Row + 1
  Sh3.Range("a1:a" & lr3).ClearContents
    For i = 1 To lr1
      x = Application.WorksheetFunction.CountIf(Sh1.Range("a1:a" & i), Sh1.Cells(i, 1))
         If x = 1 Then
               Sh3.Cells(k, 1) = Sh1.Cells(i, 1): k = k + 1
         End If
    Next
     For i = 1 To lr2
       
         y = Application.WorksheetFunction.CountIf(Sh3.Range("a1:a" & 100), Sh2.Cells(i, 1))
           If y = 0 Then
               Sh3.Cells(k, 1) = Sh2.Cells(i, 1): k = k + 1
           End If
    
     Next
End Sub

 

tarhil_from_multi_sheets.rar

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

أخي العزيز سليم

الكود يحتوي على حلقات تكرارية لكل ورقة عمل على حدا ..

السؤال : ماذا لو كان هناك على سبيل المثال 10 أوراق عمل ، وفي كل ورقة عمل لنقل 10000 صف من البيانات ..ترى كم سيستغرق الكود من الوقت لكي يقوم بعملية التنفيذ ؟

يمكن من الأخوة إنشاء مصنف به 6 أوراق عمل (5 أوراق ستكون فيها الأسماء في العمود الأول ويمتد لـ 10000 صف) وفي الورقة السادسة لإظهار النتائج

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

For Each WS In ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2"))

والسطر الآخر تغيير اسم ورقة العمل المراد إظهار النتائج بها

With Sheets("Sheet3")

أما بالنسبة للكود الخاص بك فسيكون على من يريد التعديل إضافة حلقة تكرارية لكل ورقة عمل على حدا كما فعلت بالكود ناهيك عن أن الحلقات التكرارية مميتة مع كثرة البيانات

أرجو أن يتسع صدرك لملاحظاتي

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

مغك كل لحق من هذه الناحية

لكن ما رأيك ان نقوم بذلك بواسطة المعادلات(غلى صفحتين فقط)

انظر الى الصفحة 4 من المرفق

 

tarhil_from_multi_sheets 1.rar

[أبوبسمله]

5 ساعات مضت, محي الدين ابو البشر said:

السلام عليكم

استاذ ياسر

ولا أجمل

جزاك الله خيراً كثيرا حتى ترضى

 

السلام عليكم

استاذ احمد

حاولت في الطريقة ولكن لم أنجح بتحديد الأسماء في شيتين من شيت واحدة الامور تمام ولكن من شيت 1 وسيت2 لم تنجح معي

بصراحه لم افهم ما تريد قوله 

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

بالتوفيق

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

طبتم واهتديتم

[أبوبسمله]

الطريقه الى اشرت اليها تعمل فى نفس الصفحه فقط وليس على صفحات مختلفه مع بعض

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

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

ممكن تلاقى نسبة خطأ فى الاسماء مثلا عبدالله وعبد الله - الفلاجى و الفلاجي

للتوضيح فقط اخى الغالى

بالتوفيق

 

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

أخي الحبيب أحمد

مدخلات صحيحة + كود منضبط حسب ورقة العمل وهيكلتها = نتائج صحيحة إن شاء الله

[أبوبسمله]

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

ولكن ما جعلنى الفت النظر لهذا انه ممكن يكون فى مستخدم اخر ولم يكن هناك قيود فستكون النتيجه مش صحيحه 10%

جزاك الله كل خير اخى وحبيبى ابوالبراء

[محي الدين ابو البشر]

9 ساعات مضت, أحمد الفلاحجى said:

الطريقه الى اشرت اليها تعمل فى نفس الصفحه فقط وليس على صفحات مختلفه مع بعض

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

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

ممكن تلاقى نسبة خطأ فى الاسماء مثلا عبدالله وعبد الله - الفلاجى و الفلاجي

للتوضيح فقط اخى الغالى

بالتوفيق

 

شكرا لك على التوضيح

بارك الله بك

=IFERROR(IFERROR(INDEX(List1;MATCH(0;IF(ISBLANK(List1);1;COUNTIF($C$1:C1;List1));0));INDEX(List2;MATCH(0;IF(ISBLANK(List2);1;COUNTIF($C$1:C1;List2));0)));"")


اساتذتي الكرام
السلام عليكم
وجدت هذه المعادلة في أحد المواقع الأجنبية
أرجو تقييمها من جهة
ومن جهة أخرى كيف نجعل 
list1 & list2
مطاطية أو متغيرة بحسب طول القائمة
وشكراً لكم على تفاعلكم معي

 

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

أخي الكريم محي الدين

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

=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A))

وقم بإنشاء نطاق مسمى ثاني باسم List2 وضع المعادلة التالية فيه

=OFFSET(Sheet2!$A$1,0,0,COUNTA(Sheet2!$A:$A))

 

 

وفي ورقة العمل الثالثة ستترك الخلية A1 وتبدأ المعادلة من الخلية A2 لتصبح بهذا الشكل (طبقاً لمثالك)

=IFERROR(IFERROR(INDEX(List1,MATCH(0,IF(ISBLANK(List1),1,COUNTIF($A$1:A1,List1)),0)),INDEX(List2,MATCH(0,IF(ISBLANK(List2),1,COUNTIF($A$1:A1,List2)),0))),"")

وهذه معادلة صفيف أي يجب الضغط على Ctrl  + Shift + Enter ...

[محي الدين ابو البشر]

السلام عليكم واسعد الله صباحكم بكل خير

بارك الله بك استاذ ياسر

 

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

وعليكم السلام أخي الحبيب محي الدين

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

الحمد لله أن تم المطلوب على خير ..