كيف تحديد الاسماء الثلاثية المكرره من بين الف اسم؟

[صالح ربيع]

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

عندي 850 اسم اريد احدد الاسماء المكرره في اسماء كتبت رباعيه وفي اسماء كتبت ثلاثية.
هل في طريقة لتحديد الاسماء الثلاثية المكررة .
اللي اشتي اوصل له مثلاً اسم    حمود محمد علي       بدون لقب.
واسم ثاني حمود محمد علي حزيمي       بلقب.

*** كيف احدد هؤلاء الاسمين المكرره بدون لقب ؟
اشتي احدد المكرره متشابهه بأول ثلاثة أسماء؛ لأن الاسماء كثيرة من اكثر من الف اسم.
 

111.xls

[الرائد77]

تفضل

تحديد الاسماء الثلاثية المكررة

11.xlsm

[صالح ربيع]

لقد تم الحصول على الجواب الصحيح

 

$ تحديد الاسماء الثلاثية المكررة $.xls

[عبدالفتاح في بي اكسيل]

بعد اذن  الاستاد  الرائد      قد   يساعدك   هذا  الكود   

 

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range, dic As Object, rng As Range, chn As Range
  Dim sNms As Variant, a_b As String, i As Long
  
  Set chn = Intersect(Target, Range("C:C"))
  
  If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Set rng = Range("C1", Range("C" & Rows.Count).End(3))
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    rng.Font.Bold = True
    rng.Font.ColorIndex = xlAutomatic
    For Each c In rng
      sNms = Split(c, " ")
      a_b = ""
      If UBound(sNms) = 2 Or UBound(sNms) = 3 Then
        a_b = Trim(sNms(0) & " " & sNms(1) & " " & sNms(2))
        If Not dic.exists(a_b) Then
          If UBound(sNms) = 3 Then
            dic(a_b) = c.Row
          End If
        Else
          c.Characters(1, Len(a_b)).Font.Color = vbRed
          Range("C" & dic(a_b)).Characters(1, Len(a_b)).Font.Color = vbRed
        End If
      End If
    Next c
  End If
End Sub

 

11.xlsm

[صالح ربيع]

شكراً استاذ عبدالفتاح

 

 

 

[أحمد يوسف]

صالح ربيع

أين انت من كل هذه الإجابات ؟!!!

أين الضغط على الإعجاب لكل هذه الإجابات الممتازة والأكواد الرائعة واعتقد ان هذا اقل ما يقدم لصاحب الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!!!!!💙