Discussion :

[galigori]

Bonsoir,

J'essaie de développer une macro excel qui va m'éviter des heures de travail... et je sais déjà que je vais avoir plusieurs problèmes vu que je suis niveau 0 en macro. Je m'inspire donc d'exemples variés trouvés sur google... mais ça ne marche pas fort!
Alors j'espère que vous pourrez m'aider

Voilà mon problème. Je récupère des fichiers d'adresses, et les noms des villes sont toujours orthographiés différemment. Exemple : Saint Jean de Luz, SAINT JEAN DE LUZ, Saint-Jean-de-Luz, Saint-Jean de Luz .... il y a aussi les problèmes d'accents avec d'autres villes...

Je dispose donc de deux fichiers : villes et adresses. Le fichier villes contient l'orthographe utilisé par la base de données de mon site web. Le fichier adresses contient des villes orthographiées différemment. Je veux comparer l'orthographe des villes du fichier adresses avec l'orthographe des villes du fichier ville.

Première étape... ça ne marche déjà pas !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub ReconVille()
Dim Cel As Range
 
Application.ScreenUpdating = False
 
For Each Cel In Range([D1], [D65536].End(xlUp))
Cel.Offset(0, 2) = "=VLOOKUP(Cel,[BDDvillesE.xls]Villes!C2,1,FALSE)"
Next Cel
Application.ScreenUpdating = True
End Sub

J'ai l'impression qu'il cherche le mot "Cel" partout au lieu de chercher le contenu de la cellule indexée par Cel. Que dois-je modifier?

Ensuite, pour les étapes suivantes, s'il n'a pas trouvé le nom de la ville orthographié correctement, j'envisage de lui faire modifier le nom cherché (supprimer tous les accents et remplacer tous les tirets par des espaces) et de comparer avec les noms écrits ainsi dans mon fichier ville. Je ne sais pas encore comment faire ça... si quelqu'un a une suggestion, je suis preneur. Sinon, je vais chercher quand j'aurai franchi la première étape

Merci d'avance.

[Pierre Fauconnier]

Bonjour

Tu ne peux pas passer une formule de cette manière à une cellule en VBA.

Tu dois recomposer la chaine composant la formule et la passer à la propriété Formula de l'objet cellule.

De plus, il n'est pas utile de boucler pour réaliser cela. Le plus rapide est de placer la formule dans la première cellule puis d'effectuer un copier-coller.

Cela donnerait ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub ReconVille()
  Dim Cel As Range
 
  Application.ScreenUpdating = False
 
  Set Cel = Range("f1")
  Cel.Formula = "=VLOOKUP(" & Cel.Offset(0, -2).Address(0, 0) & ",[BDDvillesE.xls]Villes!C2:C1000,1,FALSE)"
  Cel.Copy Destination:=Range("f1:f" & Range("d65536").End(xlUp).Row)
 
  Application.ScreenUpdating = True
End Sub

! Je n'ai pas testé avec un fichier valide, il faudra donc peut-être adapter la formule.

[casefayere]

Bonjour galigori, Pierre, le forum
J'ai peut-être tort mais je me méfie des valeurs comparées par VLOOKUP.
Alors entre temps, je me suis amusé à faire ce code, en estimant que dans les noms de ville, seuls les espaces ou les tirets peuvent etre différents, mais on peut encore adapter, bon ça vaut ce que ça vaut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ReconVille()
Dim i As Long, text1 As String, text2 As String, Cel As Range, tableau As Range
Application.ScreenUpdating = False
Set tableau = Workbooks("BDDvillesE.xls").Sheets("Villes").Range("C2:C1000")
For Each Cel In Range([D1], [D65536].End(xlUp))
    text1 = UCase(Application.WorksheetFunction.Substitute _
    (Application.WorksheetFunction.Substitute(Cel, " ", ""), "-", ""))
    For i = 0 To 1000
    text2 = UCase(Application.WorksheetFunction.Substitute _
    (Application.WorksheetFunction.Substitute(tableau(i), " ", ""), "-", ""))
        If text1 = text2 Then
            Cel.Offset(0, 2) = tableau(i)
        End If
    Next i
Next Cel
Application.ScreenUpdating = True
End Sub

Bonne journée

[galigori]

Ca y est! Tout fonctionne!

Je m'en sors finalement avec ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function MajSansAccent$(ByVal Chaine$)
'Ti
Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûü-'", VSsAccent = "aaaaaaeeeeiiiioooooouuuu  "
Dim Bcle&
If Len(Chaine) > 0 Then
For Bcle = 1 To Len(VAccent)
Chaine = Replace(Chaine, Mid(VAccent, Bcle, 1), Mid(VSsAccent, Bcle, 1))
Next Bcle
MajSansAccent = UCase(Chaine)
End If
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub ReconVille()
Dim Cel As Range
 
Application.ScreenUpdating = False
 
Set Cel = Range("f1")
  Cel.Formula = "=VLOOKUP(MajSansAccent(LOWER(TRIM(" & Cel.Offset(0, -2).Address(0, 0) & "))),[BDDvillesE.xls]Villes!A:B,2,FALSE)"
  Cel.Copy Destination:=Range("f1:f" & Range("d65536").End(xlUp).Row)
 
Application.ScreenUpdating = True
End Sub

La fonction MajSansAccent n'est pas de moi, je l'ai trouvée (par google) sur un autre forum.... j'espère que j'ai le droit de la copier ici ? Sinon, n'hésitez pas à l'effacer !

J'ai écarté la solution de Casefayere, parce que j'avais un peu de mal à comprendre la syntaxe utilisée (et donc à la modifier pour l'adapter à mon problème). Mon programme n'est peut-être pas optimisé, mais en général, je n'ai que 200 villes à comparer (avec la BDD qui, elle, contient 36000 villes), donc c'est instantané.

Merci encore à tous les deux. Qu'est-ce que c'est agréable de voir excel faire automatiquement en une seconde un travail qui jusque là me prenait des heures !