كيف أقارن بين جدولين

[Ahmed Wahba]

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

أخوكم أحمد جديد معكم في المنتدى، ومما رأيته رائعا الإجابة على أسئلة السائلين من غير بخل عليهم، جزاكم الله خيرا.

عندي سؤال:

عندي ملف به قائمتين:

القائمة الأولى تحتوي على عمودين:

العمود الأول: أسماء العملاء

العمود الثاني: إيداعات العملاء

القائمة الثانية تحتوي على نفس العمودين السابقين لكن ببعض الزيادات والنقصان في أسماء العملاء وبتغير أيضًا في إيدعات العملاء.

حتى لا أطيل عليكم، أريد أن يتم فرز القائمتين ليقابل كل اسم عميل نفس اسمه في القائمة الثانية وينقل أمامه وأيضًا ينقل إيداعه في القامئة الثانية

وإليكم الملف التوضيحي، شيت 1 به القائمتين، شيت 2 به النتيجة المرادة، ولكن لا يمكنني فعل ذلك يدويا مع حوالي 1200 عميل.

وليس شرطًا نفس النتيجة التي أخرجتها، وإنما أي نتيجة تقارب ذلك تفي بالغرض بإذن الله.

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

Book1.rar

[ابراهيم الحداد]

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

ارجو ان يكون هو ذا طلبك

Book1.rar

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

 جرب هذا الملف

لا يترك لك فراغات غير مرغوب فيها 

compair 2 cols salim.zip

 

تم تعديل أغسطس 20, 2015 بواسطه سليم حاصبيا

[مختار الجغرافي]

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

 

ما أروع دالة if مع الدالة العظيمة VLOOKUP 

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

أخي الكريم مختار ..هل أنت من طرح الموضوع أم أن أحمد شخص آخر؟

هل لديك حسابان في المنتدى؟

إذا كان الموضوع موضوعك فهل تم الأمر كما تريد أم أنه ما زالت توجد لديك طلبات بخصوص نفس الطلب؟

لأني لاحظت أن شكل المخرجات المطلوبة غير المعروضة ..رغم أن المعروضة في غاية الروعة والإبداع ..

[Ahmed Wahba]

اعذروني على التأخير، وجزاكم الله جميعا خيرا على الاهتمام والرد

سأرى النتيجة وأبلغكم بالتطورات

نفع الله بكم أجمعين

[Ahmed Wahba]

جزاكم الله خيرًا جميعا على المجهود والاهتمام.

والعضو زيزو العجوز ـ أشكره كثيرا ـ النتيجة ممتازة كما أريد إن شاء الله

وأشكر أيضًا العضو سليم حاصبيا على مجهوده واهتمامه

وأسأل الله أن يجعلني أنفع الناس مثلكم.

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

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

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

إثراءً للموضوع إليك الكود التالي ..قم بالضغط على زر الأمر "قل : الحمد لله" في ورقة العمل الثانية لتظهر لك النتائج تقريباً كما أرفقتها في المشاركة الأولى ..

Option Explicit

Sub ExtractExistingNonExisting()
    Dim Coll As New Collection, Arr1, Arr2, ArrOut(), Str1 As String
    Dim pDup As Long, pUniq As Long, I As Long, P As Long

    With Sheets("Sheet1")
        Arr1 = .Range("A1").CurrentRegion.Value
        Arr2 = .Range("D1").CurrentRegion.Value
    End With
    ReDim ArrOut(1 To (UBound(Arr1, 1) + UBound(Arr2, 1)), 1 To 8)

    On Error Resume Next
    For I = 1 To UBound(Arr2, 1)
        Coll.Add Key:=CStr(Arr2(I, 1)), Item:=I
    Next I
    On Error GoTo 0

    For I = 1 To UBound(Arr1, 1)
        On Error Resume Next
        Str1 = CStr(Arr1(I, 1))
        P = Coll(Str1)
        If Err Then
            pUniq = pUniq + 1
            ArrOut(pUniq, 7) = Arr1(I, 1)
            ArrOut(pUniq, 8) = Arr1(I, 2)
        Else
            pDup = pDup + 1
            ArrOut(pDup, 1) = Arr1(I, 1)
            ArrOut(pDup, 2) = Arr1(I, 2)
            ArrOut(pDup, 4) = Arr2(P, 1)
            ArrOut(pDup, 5) = Arr2(P, 2)
            Coll.Remove (Str1)
        End If
        On Error GoTo 0
    Next I

    For I = 1 To Coll.Count
        P = Coll(I)
        pUniq = pUniq + 1
        ArrOut(pUniq, 7) = Arr2(P, 1)
        ArrOut(pUniq, 8) = Arr2(P, 2)
    Next I

    Sheets("Sheet2").Range("A1").Resize(UBound(ArrOut, 1), UBound(ArrOut, 2)).Value = ArrOut
End Sub

 

Extract Existing Non-Existing From Two Lists YasserKhalil.rar

تم تعديل أغسطس 20, 2015 بواسطه ياسر خليل أبو البراء