Macro VBA pour normaliser des adresses

Question

Function AddressConvert(MonAdresse As String) As String
Dim ChaineResultat As String

Dim Element
Dim TabChaine As Variant
TabChaine = Split(MonAdresse, " ")
For Each Element In TabChaine
Select Case LCase(Element)
Case "ST": Element = "saint"
Case "STE": Element = "sainte"
Case "BD": Element = "boulevard"
Case "ALL": Element = "allée"
Case "AV", "AVE": Element = "avenue"
End Select
ChaineResultat = ChaineResultat + Element + " "
Next
AddressConvert = Left(ChaineResultat, Len(ChaineResultat) - 1)
End Function

Sub ConvertirAdresse()
 Dim LaFeuille As Worksheet
 Dim Cellule As Range
 Set LaFeuille = Worksheets("MaFeuille")
    For Each Cellule In LaFeuille.Range("Adresses")
        If Cellule.Value <> "" Then
            Debug.Print AddressConvert(Cellule.Value)
        End If
    Next Cellule
End Sub

Bonjour à tous! :D

Je suis en stage actuellement et j'ai un problème avec ma macro, en effet elle s'exécute mais ne fais juste rien, il n'y a même pas d'erreur, en tous cas il n'y a pas d'alerte.

Ce que je souhaite faire est simple, changer les abréviation: ST, STE, BRD, AVE.. etc, en leurs correspondance: SAINT, SAINTE, BOULEVARD, AVENUE.. ect

Ma feuille s'appelle bien " MaFeuille", et j'ai bien nommée ma plage de donnée avec les adresses "Adresses".

J'ai joint mon fichier avec les adresses que je dois traiter pour que vous puissiez bien visualiser les données.

S'il y a une personne qui saurait m'aider n'hésitez pas, je bloque depuis plusieurs jours...

Merci d'avance !

16macro2.xlsm (88.57 Ko)

Gabin37 · Answer

Au mois de février 2021 le temps moyen de réponse sur un post était de 5h et 21 minutes. La patience est une vertue...

Curulis · Answer

Pas de panique, Florian !

Faudra apprendre la patience : nous ne sommes pas toujours dispo voire pas inspirés non plus !
Vérifie les interprétations de certaines abréviations et même si la liste est complète : je n'ai pas scanné la totalité de la colonne.

Un double-clic sur la feuille démarre la macro

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tSplit, iIdx%, sData$
'
Cancel = True
Columns(2).Value = ""
tTab = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 1 To UBound(tTab, 1)
    sData = ""
    If InStr(tTab(x, 1), "-") > 0 Then
        iIdx = 1
        tSplit = Split(Split(tTab(x, 1), "- ")(1), " ")
    Else
        iIdx = 2
        tSplit = Split(tTab(x, 1), " ")
    End If
    Select Case tSplit(0)
        Case "ST"
            sData = IIf(tSplit(0) = "ST", "SAINT", "SAINTE")
        Case "GD", "GDE"
            sData = IIf(tSplit(0) = "GD", "GRAND", "GRANDE")
        Case "BD", "BRD"
            sData = "BOULEVARD"
        Case "PCE", "PL"
            sData = "PLACE"
        Case "AV", "AVE"
            sData = "AVENUE"
        Case "SQU"
            sData = "SQUARE"
        Case "QU"
            sData = "QUAI"
        Case "PGE"
            sData = "PLAGE"
        Case "IMP"
            sData = "IMPASSE"
        Case "RTE"
            sData = "ROUTE"
        Case "ALL"
            sData = "ALLEE"
        Case "MPE"
            sData = "MPE"
        Case "CRS"
            sData = "CRS"
    End Select
    If sData <> "" Then
        If iIdx = 1 Then tTab(x, 2) = Split(tTab(x, 1), "- ")(0) & "- "
        For y = 0 To UBound(tSplit)
            tTab(x, 2) = tTab(x, 2) & IIf(y = 0, sData, " " & tSplit(y))
        Next
    Else
        tTab(x, 2) = tTab(x, 1)
    End If
Next
Range("A2").Resize(UBound(tTab, 1), 2).Value = tTab
Columns.AutoFit
'
End Sub

16florian.xlsm (88.09 Ko)

A+