XL 2016 Ecarts entre 2 textes - trouver le nombre de différence

Poupi · 28 Juin 2021

Hello (pourExcel 2016 et 2019)
Est ce que vous pouvez m'aider pour ceci; je préviens ça s'annonce compliqué (VBA/Fonction VBA/Formules etc)
Défi:
Comparer 2 cellules A2 et B2 (plus généralement 2 colonnes sélectionnées A et B comportant une série de lettre et en sortir 1 résultat dans la cellule à côté C2 (colonne à côté col C)
Rien de mieux que des exemples, j'ai 2 versions, les plus forts peuvent essayer les 2

La version compliquée: nombre total de lettre pas trouvé dans les 2 sens (attention pour la même lettre il faut le même nombre de cette lettre ex. COCA et COKO résultat total différence = 3 càd manque la "A" à gauche comparé à droite, et manque le K et le 2e O à droite comparé à gauche)

Ex:

A	B	C
ENGIE	ENGIES	1
ESSENTIAL	ESENTIAAL	2
ARIELTO	ARIELOO	2
ARAMIS	ARMAIS	0
AKATOA	AKATO	1
AKATOAR	AKATOA	1
ENGIEFRANCECOMPAGNIE	ENGIESUEZFRANCECOMPAGNIE	4

Version un peu moins compliquée peut-être ? (les 2 versions m'intéressent) nombre de lettre de B non trouvé dans A (attention pour le même lettre il faut le même nombre de cette lettre ex. COCA et COCAA résultat = 1 le 2e A n'est pas trouvé )

Name GEKI	Name Graydon	C
ENGIE	ENGIES	1
ESSENTIAL	ESENTIAAL	1
ARIELTO	ARIELOO	1
ARAMIS	ARMAIS	0
AKATOA	AKATO	0
AKATOAR	AKATOA	0
ENGIEFRANCECOMPAGNIE	ENGIESUEZFRANCECOMPAGNIE	4
TELECC	TELEK	1

Merci d'avance pour votre expertise !
Merci bcp bcp

job75 · 28 Juin 2021

Bonsoir Poupi, patricktoulon,

Voyez le fichier joint, cette fonction VBA comptabilise les écarts entre les 2 textes :

VB:

'Option Compare Text 'activer pour ignorer la casse

Function Ecarts%(text1$, text2$)
Dim i%, x$, j%
For i = Len(text1) To 1 Step -1
    x = Mid(text1, i, 1)
    For j = 1 To Len(text2)
        If Mid(text2, j, 1) = x Then
            text1 = Left(text1, i - 1) & Mid(text1, i + 1)
            text2 = Left(text2, j - 1) & Mid(text2, j + 1)
            Exit For
        End If
Next j, i
Ecarts = Len(text1) + Len(text2)
End Function

A+

Poupi · 28 Juin 2021

Pour expliquer ce que je cherche à faire:

Je dois comparer des données et essayer de trouver le % de matching, en fonction de la longueur du string je vais tolérer x nombre de diffence pour dire Match ok ou Match Nok.

J'ai proposé pour le moment une version simple où les données sont sur la même ligne

Normalement c'est plus compliqué, on verra ce qui est possible après

Merci d'avance !

patricktoulon · 28 Juin 2021

Bonsoir
hop!!!lala!
là tu t'es lancé dans un gouffre sans fin

sauf avoir sur feuille un dictionnaire bien rempli ( et encore) pour VBA pomme et poires on la même longueur comme ca en simple (analyse orthographique )seule la dernière ou la première lettre peuvent être différente pour pouvoir juger si le mot est identique ou pas

cependant !!!!!!!!!!!!
dans l'objectif d'obtenir un % de similitude de 0% a 100%
a tu déjà entendu parler de l' algorithme de levenshtein mesurant la distance en terme de bits
je suppose que non
bien que même là ça reste de l'approximatif
en effet difficile de juger 90% ou 91% ou 92%

donc si on considere un plafond bas et un plafond haut avec cet algorithme on peut pas mal différencier la chèvre du chevreau

voici alors une fonction basé sur cet algorythme , qui va peut être t'apporter quelques lumières

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

dans le fichier ci joint
je joint à cette fonction"similaire" une fonction percent_in_auther_ordre qui me permet de cibler directement les égales meme dans le désordre sans passer par l’algorithme

il y a aussi une fonction soundex qui n'est pas de moi qui permet de corriger les caractères accentués
je ne l'utilise pas dans la démo mais rien ne t'en empêche a fin d' améliorer l'analyse de l'indice de similarité avec les deux autres fonctions

en VBA tu n'aura pas mieux comme finesse d'analyse sauf si un nouvel algorithme est sorti de nulle part et que je ne soit pas au courant

il est encore en XlS
ça fait bien longtemps que j'ai abandonné cette idée avec VBA sans dictionnaire
bien trop long pour un langage object
mais ça rend pas moins intéressant l'exercice

pour tester lance la sub test
c'est quand même un résultat assez convainquant pour le coup j'ai ajouté tes exemples

ça me rajeuni pas ce truc

ps: j'oubliais ici j'ai plafonné la similitude a plus de 80% plus tu grimpe plus c'est précis et moins il t'en trouve
Bon courage

job75 · 28 Juin 2021

Bonsoir Poupi, patricktoulon,

Voyez le fichier joint, cette fonction VBA comptabilise les écarts entre les 2 textes :

VB:

'Option Compare Text 'activer pour ignorer la casse

Function Ecarts%(text1$, text2$)
Dim i%, x$, j%
For i = Len(text1) To 1 Step -1
    x = Mid(text1, i, 1)
    For j = 1 To Len(text2)
        If Mid(text2, j, 1) = x Then
            text1 = Left(text1, i - 1) & Mid(text1, i + 1)
            text2 = Left(text2, j - 1) & Mid(text2, j + 1)
            Exit For
        End If
Next j, i
Ecarts = Len(text1) + Len(text2)
End Function

A+

patricktoulon · 28 Juin 2021

Bonsoir
pas mal du tout @job75
tu raccourci la distance après test mid sur x
il faudrait y ajouter un cumul de point 100 / len text
comptabiliser les points
et mettre un else pour les mauvais point
si + 85/90 alors c'est le bon
ça permettrais de pourvoir tester même sur une ligne différente
à raison d'un minimum d ’écart et un maximum de points

Poupi · 28 Juin 2021

Bonsoir @patricktoulon merci beaucoup

Sincèrement ça m'avance déjà pas mal du tout, car il faut savoir que je nettoie déjà pas mal de chose, je supprime tout ce qui est caractères spéciaux, les nombres, les termes rue, avenue, boulevard, place etc je convertis tous les saint vers "st" etc etc. donc c'est très bon.

Je peux me permettre de nettoyer car j'ai 3 éléments de comparaisons, le nom de la société, l'adresse et la ville ou code postal. ENGIE SAS FRANCE - RUE JEAN CELESTE DUPONT 5 et ENGIE FRANCE - RUE J. CELESTE DUPONT je dois pouvoir les matcher OK.

Bonsoir @job75

c'est incroyable cette fonction ! wouahh incroyable; car je fais déjà un Count du nombre de caractère, ça permet aussi de faire un ratio des lettres ok / nok.

Pour moi vous êtes des artistes d'Excel je vous admire, trop trop fort! j'essaierai de comprendre les codes plus tard héhé. Mais un tout grand merci déjà

Il ne me reste plus qu'à combiner vos 2 aides d'une manière ou d'une autre càd comparer une colonne de données reçues avec une colonne de données existantes (plus fournies donc), donc pas alignées évidemment mini exemple:

A) DB existant	B) DB reçu	fct percent... (de Patricktoulon)
BNP	ENGI	$A$3
ENGIE	ORANG	$A$4
ORANGE
SUEZ

Si vous avez d'autres idées c'est bienvenue évidemment;
top merci à vous

Poupi · 28 Juin 2021

Ah oui tant qu'on y est si ça intéresse, mes critères +-
Par ex. Colonne A mes données existantes, colonne B données reçues à comparer

dans la donnée reçue (colonne B, compter le nombre de lettre) , voici les tolérances pour accepter un match si le string dans col B (donc nettoyé et concaténé) a un nombre de lettre:
*between 1 to 5 letters: 0 not found = OK
*up to 7 letters: max 1 not found = OK
*up to 10 letters: max 2 not found = OK (--> voir exemple)
*up to 15 letters: max 3 not found = OK
*up to 24 letters: max 4 not found = OK
more than 24 letters: min 20 letters found = OK

exemple:

Col A	Col B	Len String B	Not found (code Job75)	Match ?
ELECTROLUX	ELEKTROLUX	10	2	OK

Ce n'est pas fixe, ça peut se faire en % aussi, mais on comprend un peu l'idée et la tolérance en fonction du nombre de lettre , plus il y a de lettres, plus on est tolérant

patricktoulon · 29 Juin 2021

Attention a l'utilisation seule de la fonction de @job75

exemple
papa-->pipi -->popo
ou bien encore
avion --> evian --> aviat
vont donner le même écart alors que ce ne sont pas du tout les même mots
ça n'a alors plus de sens

Poupi · 29 Juin 2021

patricktoulon à dit:
Attention a l'utilisation seule de la fonction de @job75

exemple
papa-->pipi -->popo
ou bien encore
avion --> evian --> aviat
vont donner le même écart alors que ce ne sont pas du tout les même mots
ça n'a alors plus de sens

Hello
Effectivement tu as raison, j'en tiens compte dans mes règles envoyées ci dessus, un mot de 5 lettres doit matcher sans différence. Donc si une seule différence c'est NOK.
Plus il y a de lettres plus je tolère le nombre de différences.
Mais ta solution va m'aider aussi surtout avec le matching dans le désordre puisque mes données à comparer ne sont pas alignées avec les existants. Je dois encore réfléchir comment combiner vos 2 aides

patricktoulon · 29 Juin 2021

bonjour
si on doit utiliser seule la fonction de @job75
les lignes dans le désordre
adapter le select case a ton gré

Poupi · 29 Juin 2021

Function Ecarts%(text1$, text2$)
Dim i%, x$, j%, final&, t1$
t1 = text1
For i = Len(text1) To 1 Step -1
x = Mid(text1, i, 1)
For j = 1 To Len(text2)
If text1 = text2 Then ecart = 0: Exit Function
If Mid(text2, j, 1) = x Then
text1 = Left(text1, i - 1) & Mid(text1, i + 1)
text2 = Left(text2, j - 1) & Mid(text2, j + 1)
Exit For
End If
Next j, i
final = Len(text1) + Len(text2)
Select Case True
Case final > 1 And Len(t1) <= 5: final = 1000
Case final < 2 And Len(t1) > 10 And Len(t1) <= 12: final = 1000
Case final = 4 And Len(t1) > 15 And Len(t1) < 20: final = 1000
Case Else: final = final
End Select
Ecarts = final
End Function
@patricktoulon
Merci beaucoup ! je vais essayer la combinaison.
Je comprends une bonne partie du code +- on va dire,
Pour dormir moins Bête, quelques questions sur ce code magique :

Que veut dire l'usage de "%" ou "$" ?
Que veut dire "To 1 Step -1"
Que veut dire "Select Case True" ? je suppose que ça check mes critères pour dire Ok ou Nok, mais où est censé être montré le résultat ok/nok ?

patricktoulon · 29 Juin 2021

RE
% c'est la meme chose que "As Integer"
exemple dim x% c'est pareil que dim x As Integer

"To 1 step -1 c'est pour les boucle a reculons
exemple
for i= 10 to 1 step-1 c'est pour boucler de 10 à 1 avec un pas de -1

select case TRUE ben ca veut dire ce que ca veut dire sélectionner la case vrai

Poupi · 30 Juin 2021

Merci je comprends un peu mieux, il reste encore un peu à comprendre de ma part,

@job75 et @patricktoulon ou un autre expert qui lit ceci

Est-ce qu'on peut rendre ce défi un peu plus complexe ? @job75 cette fonction Écart est tellement épurée pour le travail qu'il fait ! je m'attendais à un code de 2 page haha.
Est-ce possible de l'améliorer mais ça va devenir très compliqué la

imaginons que col B: Texte 2 les mots sont dans le désordre, est-ce possible d'appliquer cette fct ecart améliorée à chaque mot de la liste de la col. A (texte 1) et d'afficher en colonne C à côté du texte2 l'écart le plus court qu'il a trouvé ? en extra en colonne D le mot texte 1 qui y correspond dans la colonne A/ si rien ne correspond on affiche"non trouvé" ?

oulà c'est chaud. Merci d'avance à celui qui s'y lance

Fct Ecart actuellement: (compare A2 et B2)
A venir, comparer A:A à B2, A:A à B3...etc

Texte 1	Texte 2	Ecarts
ENGIE	ENGIES	1
ESSENTIAL	ESENTIAAL	2
ARIELTO	ARIELOO	2
ARAMIS	ARMAIS	0
AKATOA	AKATO	1
AKATOAR	AKATOA	1
ENGIEFRANCECOMPAGNIE	ENGIESUEZFRANCECOMPAGNIE	4
ENGIE	ENGIES	1
ESSENTIAL	ESENTIAAL	2
ARIELTO	ARIELOO	2
ARAMIS	ARMAIS	0
AKATOA	AKATO	1
AKATOAR	AKATOA	1

patricktoulon · 30 Juin 2021

Bonjour
heu il faut apprendre a lire un peu
comparer chaque item de la colonne A à chaque item de la colonne B
c' est justement l’ébauche que je t'ai faite avec les select case dans le modèle de @job75
si t 'a pas compris ça c'est que tu n' a rien compris au code
ben on est pas arrivé
et en plus je t'ai donné le fichier en exemple

en gros là tu demande pouvez vous m'ouvrir la porte ouverte si tu vois ce que je veux dire

Poupi · 30 Juin 2021

patricktoulon à dit:
Bonjour
heu il faut apprendre a lire un peu
comparer chaque item de la colonne A à chaque item de la colonne B
c' est justement l’ébauche que je t'ai faite avec les select case dans le modèle de @job75
si t 'a pas compris ça c'est que tu n' a rien compris au code
ben on est pas arrivé
et en plus je t'ai donné le fichier en exemple

en gros là tu demande pouvez vous m'ouvrir la porte ouverte si tu vois ce que je veux dire

C'est vrai je suis novice "je comprends un peu" j'ai dit,c'est pas cool de se moquer
Tu dois m'encourager

XL 2016 Ecarts entre 2 textes - trouver le nombre de différence

Poupi

XLDnaute Nouveau

job75

Poupi

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Poupi

XLDnaute Nouveau

Poupi

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Poupi

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Poupi

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Poupi

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Poupi

XLDnaute Nouveau

Discussions similaires