XL 2016 pourcentage de ressemblance entre deux chaines de caracteres excel

Youcho · 4 Décembre 2019

Bonjour,

j'ai en face un problème de comparer deux valeurs textes ,qui ont un taux de ressemblance élevé mais Excel malheureusement nous donne la possibilité de comparer que les valeurs identiques à 100% ,vous trouvez ci après un échantillon de mon fichier :

Nom&prénom base de données locale	Nom&prénom base de données externe	Pourcentage de ressemblance
Karimustapha	Karimustafa	la différence c'est juste "f" au lieu de "ph" donc c'est le même
Simonesara	Simonesarah	idem c'est juste une faute de frappe
Cristophegabriel	Cristphegabriell	idem c'est juste une faute de frappe

Merci pour votre collaboration .

Modeste geedee · 4 Décembre 2019

Bonsour®

Youcho à dit:
j'ai en face un problème de comparer deux valeurs textes ,qui ont un taux de ressemblance élevé mais Excel malheureusement nous donne la possibilité de comparer que les valeurs identiques à 100% ,vous trouvez ci après un échantillon de mon fichier :

Nom&prénom base de données locale
Nom&prénom base de données externe
Pourcentage de ressemblance
Karimustapha Karimustafa la différence c'est juste "f" au lieu de "ph" donc c'est le même
Simonesara Simonesarah idem c'est juste une faute de frappe
Cristophegabriel Cristphegabriell
idem c'est juste une faute de frappe

il existe une fonction grossière permettant une approche simple de cette problématique ...

ne détecte pas l'inversion nom prénom !!!
principalement basée sur les consonnes

Soundex
L'algorithme utilisé pour transformer des noms, de telle sorte que deux noms phonétiquement voisins aient même valeur, est SOUNDEX, dont une description précise est donnée dans l'ouvrage de D.Knuth, The Art of Computer Programming, Vol.3, Sorting and Searching. – Addison Wesley, 1973, page 392.
Cette fonction va calculer un code en quatre caractères (maximum) de façon à regrouper des mots de « même » consonance. Elle sera utilisée pour rechercher des valeurs dans une liste ou base de données. C'est ainsi que les mots «mètre», «mettre», «maître», ... auront le même code. Cet algorithme est d'ailleurs utilisé en généalogie pour retrouver les noms qui auraient subi une transformation due entre autres à une faute de recopie.

Voici les idées sur lesquelles s'appuie l'algorithme :

les voyelles et Y contribuent moins pour la consonance d'un mot que les consonnes. Elles seront donc supprimées sauf celle en position initiale;

les lettres H, W ont aussi une contribution minimale et seront donc supprimées sauf celle en position initiale;

les consonnes redoublées comme NN, SS et MM ou les lettres qui ont la même prononciation peuvent être réduites à une seule occurrence;

VB:

Function Soundex(s) As String
    Dim i As Integer, s1 As String
'   Suppression des espaces et     transformation du mot en majuscule
    s = UCase(Trim(s))
    s1 = Left(s, 1)
    Select Case True
        Case s1 Like "[ÀÂÄ]": s1 = "A"
        Case s1 Like "[ÉÈÊË]": s1 = "E"
        Case s1 Like "[ÎÏ]": s1 = "I"
        Case s1 Like "[ÔÖ]": s1 = "O"
        Case s1 Like "[ÙÛÜ]": s1 = "U"
        Case s1 = "Ç": s1 = "C"
    End Select
    s = s1 & Mid(s, 2)
'   Calcul du soundex'   Premier caractère
    Soundex = Left(s, 1)
'   Autres caractères
    For i = 2 To Len(s)
        If Len(Soundex) = 4 Then ' ********************possibilité d'allonger la chaîne de ressemblance
            Exit Function
        Else
            s1 = Mid(s, i, 1)
            Select Case True
                Case s1 Like "[BP]": s1 = "1"
                Case s1 Like "[CKQ]": s1 = "2"
                Case s1 Like "[DT]": s1 = "3"
                Case s1 = "L": s1 = "4"
                Case s1 Like "[MN]": s1 = "5"
                Case s1 = "R": s1 = "6"
                Case s1 Like "[GJ]": s1 = "7"
                Case s1 Like "[XZS]": s1 = "8"
                Case s1 Like "[FV]": s1 = "9"
                Case Else
                    s1 = ""
            End Select
'           Elimination des doubles
            If s1 <> "" Then
                If s1 <> Right(Soundex, 1) Then
                    Soundex = Soundex & s1
                End If
            End If
        End If
    Next i
End Function

Youcho · 4 Décembre 2019

Merci pour votre intervention , c'est très intéressant comme réponse et ca va bcp m'aider dans mon problématique.

patricktoulon · 4 Décembre 2019

Bonsoir a tous
avez vous entendu parler de l’algorithme de levenshtein
basé la dessus
reste a l'utilisateur de decider le pourcentage acceptable

VB:

Public Function similaire(ByVal s1 As String, ByVal s2 As String) As Double
 
    Const cFacteur As Long = &H100&, cMaxLen As Long = 256&   'Longueur maxi autorisée des chaines analysées
    Dim l1 As Long, l2 As Long, c1 As Long, c2 As Long
    Dim r() As Integer, rp() As Integer, rpp() As Integer, i As Integer, j As Integer
    Dim c As Integer, x As Integer, y As Integer, z As Integer, f1 As Integer, f2 As Integer
    Dim dls As String, ac1() As Byte, ac2() As Byte
    l1 = Len(s1): l2 = Len(s2)
    If l1 > 0 And l1 <= cMaxLen And l2 > 0 And l2 <= cMaxLen Then
        ac1 = s1: ac2 = s2   'conversion des chaines en tableaux de bytes
        'Initialise la ligne précédente (rp) de la matrice
        ReDim rp(0 To l2)
        For i = 0 To l2: rp(i) = i: Next i
        For i = 1 To l1
            'Initialise la ligne courante de la matrice
            ReDim r(0 To l2): r(0) = i
            'Calcul le CharCode du caractère courant de la chaine
            f1 = (i - 1) * 2: c1 = ac1(f1 + 1) * cFacteur + ac1(f1)
            For j = 1 To l2
                f2 = (j - 1) * 2: c2 = ac2(f2 + 1) * cFacteur + ac2(f2)
                c = -(c1 <> c2)   'Cout : True = -1 => c = 1
                'suppression, insertion, substitution
                x = rp(j) + 1: y = r(j - 1) + 1: z = rp(j - 1) + c
                If x < y Then
                    If x < z Then r(j) = x Else r(j) = z
                Else
                    If y < z Then r(j) = y Else r(j) = z
                End If
                'transposition
                If i > 1 And j > 1 And c = 1 Then
                    If c1 = ac2(f2 - 1) * cFacteur + ac2(f2 - 2) And c2 = ac1(f1 - 1) * cFacteur + ac1(f1 - 2) Then
                        If r(j) > rpp(j - 2) + c Then r(j) = rpp(j - 2) + c
                    End If
                End If
            Next j
            'Reculer d'un niveau la ligne précédente (rp) et courante (r)
            rpp = rp: rp = r
        Next i
        'Calcul la similarité via la distance entre les chaines r(l2)
        If l1 >= l2 Then dls = 1 - r(l2) / l1 Else dls = 1 - r(l2) / l2
    ElseIf l1 > cMaxLen Or l2 > cMaxLen Then
        dls = -1   'indique un dépassement de longueur de chaine
    ElseIf l1 = 0 And l2 = 0 Then
        dls = 1   'cas particulier
    End If
    similaire = dls * 100
End Function

pour l’occase voila un exemple lancer la sub test et regarder les address en colonne "B"

Modeste geedee · 4 Décembre 2019

patricktoulon à dit:
Bonsoir a tous
avez vous entendu parler de l’algorithme de levenshtein
basé la dessus
reste a l'utilisateur de decider le pourcentage acceptable

après 2 propositions : une phonétique, l'autre lexicale ...
l'occasion d'une fusion qui permet une sensible discrimination ....

Staple1600 · 4 Décembre 2019

Bonsoir le fil, Youcho, Modeste geedee, patricktoulon

Sinon, il y a aussi cet addin de la maison mère

NB: Le seul souci, c'est qu'il faut être un chouia anglophone
(Mais à force de titiller le VBA, on l'est tous, non ? )

patricktoulon · 4 Décembre 2019

bonsoir le fils @Staple1600 ,@Modeste geedee,@Youcho

c'est quoi cette fonction soundex? ça m’intéresse

fuzzy oui je l'avais oublié celui la

Modeste geedee · 4 Décembre 2019

patricktoulon à dit:
bonsoir le fils @Staple1600 ,@Modeste geedee,@Youcho

c'est quoi cette fonction soundex? ça m’intéresse

fuzzy oui je l'avais oublié celui la

https://www.excel-downloads.com/thr...s-de-caracteres-excel.20039035/#post-20279107

patricktoulon · 4 Décembre 2019

re
et oui je suis parti dans des algo fou
ok je rajouterais le replace des caractères spéciaux c'est pas con du tout
et en effet mieux vaut laisser les deux fonction séparées
car je me sert de l'algo pour vérifier l'orthographe aussi
donc y a tout bon je prends

merci Modeste geedee
avec ca youcho a tout

Hervé · 4 Décembre 2019

bonsoir

que j'aime vous lire sur un sujet dont je me foutais ouvertement avant la lecture du post et dont je vais me passionner jusqu’à mon ennui évident.

merci (sincèrement)

a plus

Sirfalas · 31 Janvier 2022

Modeste geedee à dit:

Bonsour®
il existe une fonction grossière permettant une approche simple de cette problématique ...

ne détecte pas l'inversion nom prénom !!!
principalement basée sur les consonnes

Regarde la pièce jointe 1047974

VB:

Function Soundex(s) As String
    Dim i As Integer, s1 As String
'   Suppression des espaces et     transformation du mot en majuscule
    s = UCase(Trim(s))
    s1 = Left(s, 1)
    Select Case True
        Case s1 Like "[ÀÂÄ]": s1 = "A"
        Case s1 Like "[ÉÈÊË]": s1 = "E"
        Case s1 Like "[ÎÏ]": s1 = "I"
        Case s1 Like "[ÔÖ]": s1 = "O"
        Case s1 Like "[ÙÛÜ]": s1 = "U"
        Case s1 = "Ç": s1 = "C"
    End Select
    s = s1 & Mid(s, 2)
'   Calcul du soundex'   Premier caractère
    Soundex = Left(s, 1)
'   Autres caractères
    For i = 2 To Len(s)
        If Len(Soundex) = 4 Then ' ********************possibilité d'allonger la chaîne de ressemblance
            Exit Function
        Else
            s1 = Mid(s, i, 1)
            Select Case True
                Case s1 Like "[BP]": s1 = "1"
                Case s1 Like "[CKQ]": s1 = "2"
                Case s1 Like "[DT]": s1 = "3"
                Case s1 = "L": s1 = "4"
                Case s1 Like "[MN]": s1 = "5"
                Case s1 = "R": s1 = "6"
                Case s1 Like "[GJ]": s1 = "7"
                Case s1 Like "[XZS]": s1 = "8"
                Case s1 Like "[FV]": s1 = "9"
                Case Else
                    s1 = ""
            End Select
'           Elimination des doubles
            If s1 <> "" Then
                If s1 <> Right(Soundex, 1) Then
                    Soundex = Soundex & s1
                End If
            End If
        End If
    Next i
End Function

Bonsoir,

Ce VBA m'intéresse énormément mais n'ayant pas assez de connaissance avec le développeur Excel, je n'arrive pas à le faire fonctionner...
J'ai copié-coller la fonction dans Microsoft viusal basic mais quand je la lance, j'ai un carré qui s'affiche avec écrit "UseForm 1" et je ne peux plus rien faire.

Vous avez quelque chose à me proposer ?

Merci par avance.

XL 2016 pourcentage de ressemblance entre deux chaines de caracteres excel

Youcho

XLDnaute Nouveau

Modeste geedee

XLDnaute Barbatruc

Youcho

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Modeste geedee

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Hervé

XLDnaute Barbatruc

Sirfalas

XLDnaute Nouveau

Discussions similaires