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

[المرجان بالمجان]

الأخوة الكرام / أعضاء منتدى أوفستا منتدى الإكسل 

من منكم يفيدني في معادلة تبين لي نسبة التشابه بين اسمين ، أو نسبة الاختلاف بينهما ، أو أي شيء يقوم مقام هذه المعادلة إن أمكن ولكم جزيل الشكر والتقدير 

 

أرجو أن تكون المعلومة وصلت 

 

أحتاجها ضروري لبرنامج رواتب 

 

مرفق ملف اكسل للتوضيح أكثر 

 

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

معادلة التشابه بين الأسماء.rar

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

ماذا تقصد  بنسبة التشابه؟ ارفق بعض النتائج المتوقعة؟

يمكنك فقط معرفة ما إذا كانت الخلايا متطابقة أو لا عن طريق استخدام الدالة EXACT .. كأن تقول

=EXACT(B3,C3)

فإذا كانتا متطابقتين يكون الناتج True وإذا لم يتم التطابق يكون الناتج False ...

ولاحظ أنه لو كان الاختلاف في مسافة واحدة فقط سيعطي False أي عدم تطابق ..

 

 

[المرجان بالمجان]

يعني مثلا يعطني نسبة التشابة بين الاسمين 80%  أو يعطيني نسبة الإختلاف بين الإسمين 20% أو ماشابه من أي معادلة تعطيني نتيجة قريبة 

 

في النهاية أود فرز قائمة الأسماء المختلفة اختلاف كبير مثلا أود أفرز القائمة الي نتائج التشابه فيها أقل من 50% 

 

 

[أبوعيد]

السلام عليكم , المرجان بالمجان

لم يتضح مطلوبك إلى الآن , الرجاء الإجابة على سؤالي أدناه حتى تتضح الفكرة

السؤال : إذا كان لدينا   الاسم الأول : محمد صالح أحمد سعيد

                             الاسم الثاني : صالح محمد أكرم فهد

كم نسبة التشابة بينهما ؟

تقبل تحياتي

تم تعديل سبتمبر 5, 2016 بواسطه أبوعيد

[المرجان بالمجان]

الجواب على سؤالي هو ما أطلبه ولا أستطيع معرفة نسبة التشابه 

أحتاج معادلة تظهر لي نسبة التشابه 

أتوقع من كثرة الأسئلة وعدم وصول المعلومة أتوقع لا يوجد معادله لطلبي لكن هناك حل آخر 

 

هل أستطيع معرفة عدد الكلمات المختلفة بين الإسمين ، أو عدد الحروف المختلفة بين الإسمين فمثلا نتيجة لمثالك التالي : 

السؤال : إذا كان لدينا   الاسم الأول : محمد صالح أحمد سعيد

                             الاسم الثاني : صالح محمد أكرم فهد

 

يكون الإسم الأول هو الأصل يقارن بالإسم الثاني 

لبيان عدد الكلمات المختلفة نستطيع أن نقول عدد الكلمات المختلف = نتيجة المعادلة هي "2" 

بمعنى أن كلمة "أكرم " و"فهد" غير موجودة في الإسم الأول 

 

ولبيان عدد الكلمات المتفقة نستطيع أن نقول عدد الكلمات المتفقة = نتيجة المعادلة هي "2" 

بمعنى أن كلمة "صالح" و " محمد " موجودة في الإسم الأول 

 

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

 

 

وجزاكم الله خيرا وبارك فيكم أخوك : عبداللطيف سيف ، المرجان بالمجان 

 

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

أخي الكريم الموضوع صعب بعض الشيء ولكن بحمد الله استطعت التوصل إلى حل قد يكون أقرب للمطلوب وإن لم يكن المطلوب بشكل تام ..

جرب الملف التالي .. وضعت فيه في العمود الأول (الاسم الأصلي) ، والعمود الثاني (الاسم الذي تريد مقارنته) .. وفي الأعمدة من 3 إلى 7 قمت بتقسيم الاسم لأن هناك أسماء مركبة كما تعلم .. فقمت بتقسيم الاسم في هذه الأعمدة ، ثم عقدت عمليات مقارنة بين كل اسم والاسم الأصلي ..

جرب الملف المرفق وإن شاء الله يفي بالغرض

رابط الملف من هنا

والكود المستخدم في الملف بالشكل التالي

'https://www.officena.net/ib/topic/71606-*
'=========================================

Sub Similar_Different_Between_Two_Names()
'Author  : YasserKhalil
'Release : 06 - 09 - 2016
'-------------------------
    Dim iRow As Long, iCol As Long
    Dim countSim As Long, countDif As Long
    Dim strSim As String, strDif As String

    Application.ScreenUpdating = False
        For iRow = 2 To Cells(Rows.Count, "B").End(xlUp).Row
            For iCol = 3 To 7
                If Cells(iRow, iCol) <> "" Then
                    If InStr(Cells(iRow, 1), Cells(iRow, iCol)) > 0 Then
                        countSim = countSim + 1
                        strSim = strSim & Cells(iRow, iCol) & " | "
                    Else
                        countDif = countDif + 1
                        strDif = strDif & Cells(iRow, iCol) & " | "
                    End If
                End If
            Next iCol
    
            If countSim > 0 Then
                Cells(iRow, 10).Value = countSim
                Cells(iRow, 11).Value = VBA.Trim(Left(strSim, Len(strSim) - 2))
            End If
    
            If countDif > 0 Then
                Cells(iRow, 8).Value = countDif
                Cells(iRow, 9).Value = VBA.Trim(Left(strDif, Len(strDif) - 2))
            End If
    
            countSim = 0: strSim = "": countDif = 0:: strDif = ""
        Next iRow
    Application.ScreenUpdating = True

    MsgBox "Done...", 64
End Sub

Function Kh_Names(FullName As String, ParamArray Index1()) As String
    Dim I As Integer
    Dim Kh_Split, MyArray, Arr
    Dim Kh_String As String, SN As String, RE As String

    On Error GoTo Err_Kh_Names
    MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الحق", " النصر", " العهد", " النور", " بالله", "زين ")

    SN = Application.WorksheetFunction.Trim(FullName)
    For Each Arr In MyArray
        RE = Replace(Arr, " ", "^")
        SN = Replace(SN, Arr, RE)
    Next Arr

    Kh_Split = Split(SN, " ", , vbTextCompare)

    On Error Resume Next
        For I = 0 To UBound(Index1)
            Kh_String = Kh_String & " " & Kh_Split(Index1(I) - 1)
        Next I
    On Error GoTo 0

    Kh_String = Replace(Trim(Kh_String), "^", " ")
    Kh_Names = Kh_String

    Exit Function

Err_Kh_Names:
    Kh_Names = ""
End Function

تقبل تحياتي

[المرجان بالمجان]

أخي ياسر 

المعادلة جميلة ونوعا ما تفي بالغرض 

اشكرك وجوزيت خيرا 

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

الحمد لله الذي بنعمته تتم الصالحات

وجزيت خيراً بمثل ما دعوت لي أخي الكريم