اظهار تكرار الاسماء

[mohammedalmaghrebi]

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

انا لسا جديد في هذا المنتدى الذي وجدته أكثر من رائع وبالتوفيق لكم جميعا 

اريد منكم المساعدة في موضوع التكرار في الاكسل 

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

محتاج كود يظهر لي الاسماء المكررة بالاسم الثلاثي فما فوق فمثلا عندي اسمين 

الاول محمد عبدالله علي صالح العواضي

والثاني محمد عبدالله علي العواضي أو محمد عبدالله علي 

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

اتمنى وصلت الفكرة وتقبلو خالص تحياتي

[صلاح الصغير]

متابع

لان لى تقريبا نفس الموضوع

[أحمد يوسف]

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

[صلاح الصغير]

متابع

 

اخى الكريم لعل هذا الملف يفيدك

من اعمال استاذ  / ياسر خليل

 

[Ali Mohamed Ali]

تفضل هذا الكود اذا قمت بالكتابة فى العمود الأول  A 

والعمود الثالث C

سيعمل هذا الكود على تلوين المتشابه الغير متماثل باللون الأصفر

Sub compare_cols122()
    Dim NameList As Worksheet
    Dim i As Long, j As Long
    Set NameList = Excel.Worksheets("Names")
    Dim rngNames As Range
    Set rngNames = Range("A1", Range("A1").Offset(Rows.Count - 1).End(xlUp))
    Dim varNames As Variant
    varNames = rngNames.Value2
    Dim rngData As Range
    Set rngData = Range("C1", Range("C1").Offset(Rows.Count - 1).End(xlUp))
    Dim varData As Variant
    varData = rngData.Value2
    Application.ScreenUpdating = False
    For i = LBound(varNames) + 1 To UBound(varNames)
        For j = LBound(varData) + 1 To UBound(varData)
            If varNames(i, 1) <> "" Then
                If InStr(1, varData(j, 1), varNames(i, 1), vbTextCompare) > 0 Then
                    NameList.Cells(j, 3).Interior.ColorIndex = 6
                    NameList.Cells(i, 1).Interior.ColorIndex = 6
                    Exit For
                Else
                End If
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub

 

[صلاح الصغير]

ممكن ملف لو تكرمت

[Ali Mohamed Ali]

تفضل

 

 

مع مقارنة عمودين مع بعضهما(1).xlsm

تم تعديل يناير 16, 2019 بواسطه ali mohamed ali

[صلاح الصغير]

 

ارجو المتابعة هنا