Croisements de données avec un pourcentage d'erreur

Le 02/02/2021 à 15:03

Bonjour,

Je suis encore novice pour tout ce qui concerne excel sauf que l'on m'a donné une tâche qui dépasse mes capacités.

Je dispose de deux tableaux que je ne peux pas partager (fichiers clients avec adresses). L'un des deux tableaux est un fichier client avec des adresses précises (numero de rue, adresse, cp, ville et numero de téléphone) et l'autre est un fichier avec des adresses pas très précises ( possibilités d'avoir deux numéros de rues ou qu'il n'y ait pas écrit le mot rue, etc). J'aimerai donc savoir si c'est possible d'associer les numéros de téléphones du tableau 1 en associant les adresses des deux tableaux avec par exemple un pourcentage d'erreur dans l'adresse. J'espère que je me suis bien fait comprendre.

Merci de votre réponse.

Le 03/02/2021 à 10:26

Salut,

Essaye la =RECHERCHEV(;;;VRAI) mais je suis pas sur de ce que ca donnera !

Le 03/02/2021 à 11:34

Bonjour,

une fonction personnalisée qui te retourne la similitude entre 2 chaines de caractères (fonction de Levenshtein)

Function Levenshtein(ByVal mot1 As String, ByVal mot2 As String, Optional typerep = 0)
    ' mot1 et mot2 chaines à comparer
    ' typerep : 0 réponse = distance de levenshtein qui correspond au nombre de caractères différents
    ' typerep : 1 réponse sous forme de pourcentage =1-distance*2/longeur(mot1+mot2)

    Dim i As Long, j As Long, bs1() As Byte, bs2() As Byte
    Dim mot1_lg As Long
    Dim mot2_lg As Long
    Dim distance() As Long
    Dim min1 As Long, min2 As Long, min3 As Long

    mot1_lg = Len(mot1)
    mot2_lg = Len(mot2)
    If mot1_lg = 0 Or mot2_lg = 0 Then
        If typerep = 0 Then Levenshtein = Application.Max(mot1_lg, mot2_lg) Else levenshstein = 0
        Exit Function
    End If
    ReDim distance(mot1_lg, mot2_lg)
    bs1 = mot1
    bs2 = mot2

    For i = 0 To mot1_lg
        distance(i, 0) = i
    Next

    For j = 0 To mot2_lg
        distance(0, j) = j
    Next

    For i = 1 To mot1_lg
        For j = 1 To mot2_lg
            If bs1((i - 1) * 2) = bs2((j - 1) * 2) Then
                distance(i, j) = distance(i - 1, j - 1)
            Else
                min1 = distance(i - 1, j) + 1
                min2 = distance(i, j - 1) + 1
                min3 = distance(i - 1, j - 1) + 1
                If min1 <= min2 And min1 <= min3 Then
                    distance(i, j) = min1
                ElseIf min2 <= min1 And min2 <= min3 Then
                    distance(i, j) = min2
                Else
                    distance(i, j) = min3
                End If

            End If
        Next
    Next

    If typerep = 0 Then
        Levenshtein = distance(mot1_lg, mot2_lg)
    Else
        Levenshtein = 1 - distance(mot1_lg, mot2_lg) * 2 / (mot1_lg + mot2_lg)
    End If
End Function

à mettre dans un module et utilisable comme fonction excel

=Levenshtein(A1;B1;1) où A1 et B1 contiennent les chaines à comparer et où 1 est le type de réponse attendue (ici % de similitude)

Le 04/02/2021 à 09:37

Bonjour, merci beaucoup pour cette réponse, mais peux-tu m'expliquer comment l'utiliser ?

encore merci

Le 04/02/2021 à 11:52

Bonjour,

peux-tu mettre un fichier exemple avec quelques données bidons ?

Le 05/02/2021 à 00:36

Bonsoir,

une proposition via une macro (à lancer via alt-F8), basé sur % de mots communs, plutôt que levenshtein.

edit : fichier supprimé car fichier non anonymisé

Function pctmotscommuns(texte1, texte2)
'donne le pourcentage de mots communs entre 2 chaines de caractères
    m1 = Split(adapte(texte1), " ")
    ctrm1 = UBound(m1) ' compteur mots texte1
    If LBound(m1) = 0 Then ctrm1 = ctrm1 + 1
    t2 = adapte(texte2)
    m2 = Split(t2, " ")
    ctrm2 = UBound(m2) 'compteur mots texte 2
    If LBound(m2) = 0 Then ctrm2 = ctrm2 + 1
    For i = LBound(m1) To UBound(m1)
        If m1(i) <> "" Then
            For j = LBound(m2) To UBound(m2)
                If m2(j) <> "" Then
                    If m1(i) = m2(j) Then
                        sim = sim + 1 'compteur mots communs
                        t2 = Replace(t2, m2(j), " ", 1) 'on enlève le mot trouvé
                        t2 = Replace(t2, "  ", " ")
                        m2 = Split(t2, " ")
                        Exit For
                    End If
                End If
            Next j
        End If
    Next i
    pctmotscommuns = sim * 2 / (ctrm1 + ctrm2)  'pourcentage mots communs (sur base de la moyenne des longueurs des 2 textes)
End Function

Function adapte(texte)
    ' standardisation du texte (suppression des caractères de ponctuation, et remplacement des abréviations (à compléter)
    t = " " & Application.Clean(LCase(texte)) & " "
    t = Replace(t, "-", " ")
    t = Replace(t, ".", " ")
    t = Replace(t, ",", " ")
    t = Replace(t, ":", " ")
    t = Replace(t, "'", " ")
    t = Replace(t, Chr(160), " ")
    t = Replace(t, " st ", " saint ")
    t = Replace(t, " av ", " avenue ")
    t = Replace(t, " dr. ", " docteur ")
    t = Replace(t, " rue ", " ")
    t = Replace(t, " avenue ", " ")
    t = Replace(t, " bis ", " ")
    t = Replace(t, " du ", " ")
    t = Replace(t, " de la ", " ")
    t = Replace(t, " boulevard ", " ")
    t = Replace(t, " bâtiment ", " ")
    adapte = Trim(t)
End Function

Sub aargh()
Set ws1 = Sheets("sheet1") ' à adapter
Set wss2 = Sheets("sheet2") ' à adapter

    pct = ws1.Range("F1") 'pourcentage minimum
    wss2.Copy after:=wss2 'copie de la feuille dans une feuille de travail
    Set ws2 = ActiveSheet
    dl1 = ws1.Cells(Rows.CountLarge, 1).End(xlUp).Row 'nombre de lignes ws1
    dl2 = ws2.Cells(Rows.CountLarge, 1).End(xlUp).Row 'nombre de ligne ws2
    tab3 = ws2.Range("A1").Resize(dl2, 1).Value ' col a de ws2 dans tab3 (performances)
    ws2.Range("A1").Resize(dl2, 5).Sort key1:=ws2.Range("C1"), order1:=xlAscending, Header:=xlYes 'tri ws2 sur code postal
    tab1 = ws1.Range("A1").Resize(dl1, 7).Value 'col A-G de ws1 dans tab1 (performances)
    tab2 = ws2.Range("A1").Resize(dl2, 5).Value 'col A-E de ws2 dans tab2 (performances)

    For i = 2 To dl2
        tab2(i, 1) = adapte(tab2(i, 1)) ' reformattage et standardisation des adresses de tab2
    Next i

    For i = 2 To dl1 'on examine chaque adresse de tab1
        cp = tab1(i, 3) 'cp = code postal en ligne i de tab1
        For j = 2 To dl2 'recherche dans tab2 de la première ligne avec ce code postal
            If cp = tab2(j, 3) Then Exit For 'code postal trouvé en tab2
        Next j
        If j < dl2 Then 'code postal trouvé en tab2
            meilleurpct = 0 'meilleur pourcentage
            For k = j To dl2 ' on parcourt chaque adresse de tab2
                If cp <> tab2(k, 3) Then Exit For 'code postal différent on arrête la recherche
                r = pctmotscommuns(adapte(tab1(i, 1)), tab2(k, 1)) 'calcul % mots communs
                If r > meilleurpct Then ' meilleur pct trouvé
                    meilleurpct = r 'on le mémorise
                    If r >= pct Then 'pct trouvé supérieur ou égal au minimum demandé
                        m = tab2(k, 5): tab1(i, 5) = k: tab1(i, 6) = r: tab1(i, 7) = tab3(m, 1): tab1(i, 4) = tab2(k, 4) 'on sauve les données d'intérêt
                    End If
                End If
            Next k 'adresse suivante de tab2
        End If
    Next i 'adresse suivante de tab1
    ws1.Range("A1").Resize(dl1, 7) = tab1 ' resultats dans ws1
    ws1.Activate
    'suppression feuille de travail
    Application.DisplayAlerts = False
    ws2.Delete
    Application.DisplayAlerts = True
End Sub
Rechercher des sujets similaires à "croisements donnees pourcentage erreur"