XL 2019 Power query - remplacer une chaîne de caractère par une autre

[Flx1er]

Bonjour,
Je dois "nettoyer" un champ "Lieu" qui provient d'une zone de texte libre, donc avec tout le cortège d'erreur possible.
Je désire remplacer les lieux présents sur "Tab_Lieu_saisie" par les lieux de références de "Tab_Lieu_De_Référence".

Dans l'exemple joint, j'ai remplacé manuellement chaque chaîne de caractères, mais il doit y avoir une méthode, une solution beaucoup plus rapide.
Pour information, dans mon exemple, j'ai seulement inscrit 2 lieux de références. En réalité, je dispose d'une trentaine de lieux.
En vous remerciant de votre aide
Cordialement

 

[job75]

Bonjour Fix1er,

Le problème est tarabiscoté mais il se règle sans problème par formule, en colonne H :

=RECHERCHEV(SUBSTITUE(SUBSTITUE(SUBSTITUE(SUBSTITUE(SUBSTITUE([@[Lieu saisi]];".";);"…";);";";);" ";"*");"s";"*");Tab_Lieu_De_Référence;1;0)

A+

 

[ben724914]

Voici une solution en powerquery.
en Xl2019, il faut passer par l'éditeur avancée sinon l'option "correspondance approximative" n'est pas disponible.
et mettre en texte les colonnes de lieu avant de faire la fusion. bonne utilisation/adaptation.

 

[Cousinhub]

Bonjour,
Avec Power Query, en mettant un seuil de similarité à 0.5, on obtient le résultat voulu...
A vérifier donc avec plus de données...

Bonne soirée

 

[patricktoulon]

Bonjour
sinon par vba une fonction perso"presque" utilisant ma fonction similaire

formule en I2
=presque(G2;Tab_Lieu_De_Référence[Lieu de référence])

Function presque(cel As String, ts As Range)
    Dim x#, z#
    t = ts.Value
    For i = 1 To UBound(t)
        x = similaire(cel, t(i, 1)): If x > z Then z = x: presque = t(i, 1)
    Next
End Function



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
    Dim px As Double, p As Double, oz As Long
    s1 = LCase(s1): s2 = LCase(s2)
    If InStr(s1, " ") > 0 Then
        tbl = Split(Replace(s1, "-", " "), " ")
        p = 100 / UBound(tbl)
        For oz = 0 To UBound(tbl): px = px + IIf(s2 Like "*" & tbl(oz) & "*", p, 0): Next
        If px >= 100 Then similaire = 100: Exit Function
    Else
        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 If
End Function

 

[Flx1er]

Bonjour,
Avec Power Query, en mettant un seuil de similarité à 0.5, on obtient le résultat voulu...
A vérifier donc avec plus de données...
Regarde la pièce jointe 1176180
Bonne soirée

Bonjour et merci à tous, pour les solutions proposées.
La solution de Cousinhub s’intègre et correspond à la résolution de mon problème
Bien cordialement