Comparaison chaine de texte

[Zeus]

Bonjour à vous.
Besoin d'aide sur un fichier compliqué (pour moi).
En fait j'ai un fichier avec des milliers de ligne et une colonne A qui contient des noms mal écrits pour la plupart et j'ai un liste (colonne E) avec les noms tels qu'ils devraient être écrits. J'aimerais une formule qui lit une cellule avec nom mal écrit et recherche le nom adéquat dans la bonne liste et remplace ce nom mal écrit. Bon la formule peut bien être placée dans une colonne D par exemple.
Je mets un exemple en PJ si je n'ai pas été assez clair.

Merci d'avance.

 

[job75]

Bonjour Zeus, eriiiic, JM, Lone-wolf,

L'inconvénient de l'addin de MS c'est qu'il traite tous les noms du tableau, ce qui peut être très long.

Pour traiter les noms un par un placer cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Or Application.CountA([E:E]) < 2 Then Target(1, 3) = "": Exit Sub
Dim x$, t, mini, i&, d, y$
x = Target
t = [E2].Resize(Application.CountA([E:E])) 'tableau VBA, plus rapide
mini = 9 ^ 9
For i = 1 To UBound(t)
    d = Levenshtein(x, t(i, 1))
    If d < mini Then mini = d: y = t(i, 1)
Next
If y = t(1, 1) Then y = "Distance trop grande"
Target(1, 3) = y
End Sub

la fonction Levenshtein calculant la "distance" entre 2 textes :

Function Levenshtein(s1, s2)
Dim i%, j%, L1%, L2%, d%(), min1%, min2%
L1 = Len(s1)
L2 = Len(s2)
ReDim d(L1, L2)
For i = 0 To L1
    d(i, 0) = i
Next
For j = 0 To L2
    d(0, j) = j
Next
For i = 1 To L1
    For j = 1 To L2
        If Mid(s1, i, 1) = Mid(s2, j, 1) Then
            d(i, j) = d(i - 1, j - 1)
        Else
            min1 = d(i - 1, j) + 1
            min2 = d(i, j - 1) + 1
            If min2 < min1 Then min1 = min2
            min2 = d(i - 1, j - 1) + 1
            If min2 < min1 Then min1 = min2
            d(i, j) = min1
        End If
    Next
Next
Levenshtein = d(L1, L2)
End Function

Fichier joint.

A+

 

[job75]

Re,

J'ai ajouté l'affichage de "Distance trop grande" dans le fichier précédent.

A+

 

[job75]

Re,

Durée d'exécution d'une validation en colonne B avec davantage de noms (copiés-collés) en colonne E :

- 3 000 noms en colonne E => 0,4 seconde chez moi sur Win 10 Excel 2013

- 30 000 noms en colonne E => 3,6 secondes.

A+

 

[Lone-wolf]

Bonsoir job75

Est-ce qu'il y a possibilité de faire ceci

liste des noms: ANABA GABRIELLE - Nom saisi: ana gab.

Avec le nom saisi en minuscule, il retrouve quand même le nom en majuscule.

 

[job75]

Bonjour Lone-wolf, le forum,

Lone-wolf je pense que ton niveau devait te permettre de trouver la solution :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = "" Or Application.CountA([E:E]) < 2 Then Target(1, 3) = "": Exit Sub
Dim x$, t, mini, i&, d, y$
x = LCase(Target)
t = [E2].Resize(Application.CountA([E:E])) 'tableau VBA, plus rapide
mini = 9 ^ 9
For i = 1 To UBound(t)
    d = Levenshtein(x, LCase(t(i, 1))) 'la casse est ignorée
    If d < mini Then mini = d: y = t(i, 1)
Next
If y = t(1, 1) Then y = "Distance trop grande"
Target(1, 3) = y
End Sub

Fichier (2).

Bonne journée.

 

[Lone-wolf]

Bonjour job75, le Forum

Dans ce cas ci et comme tant d'autres, la macro est complexe pour moi.
Et savoir ou placer LCase ou Ucase, bonne chance.

 

[eriiic]

Bonjour,

normalement, avec la distance de Levenshtein, on doit atteindre un score minimum pour considérer la cible comme correcte pour ne pas ramener de faux positifs.
Là si j'ai Jacques Durand il me ramène Jacques Duclaux, ou bien sur Duclau Jacque il me ramène ANABA GABRIEL.
C'est un choix de conception, et je pense que ça mérite d'être signalé aux futurs utilisateurs selon l'usage qu'ils en auront.
eric

 

[job75]

Re eriiiic,

Oui avec le code que j'ai donné il faut que le texte saisi ne diffère pas trop du texte recherché.

En fait c'est un correcteur d'orthographe.

A+