Comment exécuter plusieurs formules SUBSTITUTE l'une après l autre

Le 09/08/2021 à 09:29

Bonjour à tous peut être que quelqu'un sera m'aider à résoudre ce problème ,

Avec la fonction SUBSTITUTE , j'essaye de modifier une colonne avec des adresses contenant des abréviations comme CHEE , AV, R , pour être modifiée en devenant Chaussée , Avenue ou Rue car j'utilise ce champ pour créer un lien Google maps mais Google ne reconnait pas toujours les abréviations voici ce que j 'ai tenté mais ca ne fonctionne pas..

Macro créer nvl colonne adresse sans abréviations et tiret pour Google maps'
'
    Range("AF5").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-28],""-"","" "")"
    Selection.AutoFill Destination:=Range("AF5:AF600"), Type:=xlFillDefault

    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-28],""CHEE"",""CHAUSSEE"")"
    Selection.AutoFill Destination:=Range("AF5:AF600"), Type:=xlFillDefault

    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-28],""R"",""RUE"")"
    Selection.AutoFill Destination:=Range("AF5:AF600"), Type:=xlFillDefault

    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-28],""AL"",""ALLEE"")"
    Selection.AutoFill Destination:=Range("AF5:AF600"), Type:=xlFillDefault

    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-28],""CL"",""CLOS"")"
    Selection.AutoFill Destination:=Range("AF5:AF600"), Type:=xlFillDefault

    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-28],""AV"",""AVENUE"")"
    Selection.AutoFill Destination:=Range("AF5:AF600"), Type:=xlFillDefault
    Columns("AF:AF").Select
    Selection.Copy
    Columns("AG:AG").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False '

D'avance merci beaucoup pour votre aide .

Le 09/08/2021 à 09:45

Bonjour,

Si en plus la dernière ligne n'est pas forcément 600, essayez ceci:

    DerLig = Range("AF" & Rows.Count).End(xlUp).Row
    Range("AF5:AF" & DerLig).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(RC[-28],""-"","" ""),""CHEE"",CHAUSSEE),""R"",""RUE""),""AL"",""ALLEE""),""CL"",""CLOS""),""AV"",""AVENUE"")"

Cdlt

Le 09/08/2021 à 09:47

Bonjour à tous,

Voici un essai pour obtenir les données en valeur directement en colonne AF :

sub test()
tbefore = array("-", "CHEE", "R", "AL", "CL", "AV")
tafter = array(" ", "CHAUSSEE", "RUE", "ALLEE", "CLOS", "AVENUE")
with Range("AF5:AF600")
    t = .offset(0, -28).value
    for i = lbound(t) to ubound(t)
        for j = lbound(tbefore) to ubound(tbefore)
            t(i, 1) = replace(t(i, 1), tbefore(j), tafter(j))
        next j
    next i
    .value = t
end with
end sub

Attention, il est possible d'obtenir des résultats inattendus avec des "R", "AL", "CL" ou "AV" à remplacer...

Cdlt,

Le 09/08/2021 à 10:53

Bonjour,

Une approche Power Query.
Cdlt.

13luc1276.xlsx (19.57 Ko)
Le 10/08/2021 à 10:37

Bonjour,

Un petit retour sur les différentes propositions ?
Cdlt.

Le 10/08/2021 à 11:20
14testmacroadresse.xlsm (23.09 Ko)

Sorry de ne répondre que maintenant , un grand merci à tous pour vos solutions et vos réponses rapides !

Juste Arturo83 j'apprécie ta solution qui se rapproche un peu de ce que j 'ai tenté et surtout qui me permet de pas aller jusque la ligne 600 ;-) , mais j 'ai un soucis avec ta macro car il y a un résultat que pour les lignes 1 à 5 et la 5 ème qui devrait donner une adresse ne donne rien non plus "#NOM?" je ne sais pas pourquoi cela bug..

Et ce que j'aimerais pouvoir faire c 'est de supprimer ces colonnes qui m ont aidé à donner une meilleur adresse pour le lien Google maps ,

mais je n 'arrive pas à supprimer ces colonnes pour l instant sans perdre les données du lien , j'ai tenté de recopié la colonne lien google dans une autre mais si je supprime ces colonnes d'adresse je perds le lien..

Voici mon fichier avec mes macros qui redimensionnent un tableau de données brutes .

Encore merci pour votre aide

Le 10/08/2021 à 12:00

Bonjour,

Ne sachant pas comment était fait votre fichier, j'ai fait sans cela.

donc pour trouver la dernière ligne (Colonne "A" à la place "AF")

    DerLig = Range("A" & Rows.Count).End(xlUp).Row

ensuite:

donne rien non plus "#NOM?" je ne sais pas pourquoi cela bug..

tout simplement il maque les guillemets qui doivent encadrer "CHAUSSEE" dans la formule

    Range("AF5:AF" & DerLig).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(RC[-28],""-"","" ""),""CHEE"",""CHAUSSEE""),""R"",""RUE""),""AL"",""ALLEE""),""CL"",""CLOS""),""AV"",""AVENUE"")"

Tout votre code est à revoir pour obtenir un meilleur rendement. Pour le moment je n'ai pas le temps, je regarderai plus tard pour vous l'améliorer.

Cdlt

Le 10/08/2021 à 13:38

Mercii mille fois Arturo 83 ! pour votre solution à mon problème et votre rapidité oui c'est un code que j'ai formé petit à petit morceau par morceau effectivement il est très très lourd ;_)

Le 10/08/2021 à 15:18

Bonjour,

Et quid de l'approche Power Query avec une table de correspondance ?
Cdlt.

Le 11/08/2021 à 08:02

Bonjour,

Comme promis, voici votre macro (les premières lignes de la première partie) retravaillée.

' Macro 1 ********************************************************************
    Dim i As Long, DerLig As Long

    Application.ScreenUpdating = False 'Evite les rafraîchissement de l'écran entre 2 actions et augmente la vitesse d'exécution
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Range("Q4").Value = "Prix" 'Ecrit Prix dans le titre de la colonne Q
    Range("Q5:Q" & DerLig).FormulaR1C1 = "=MAX(RC[-5]:RC[-1])"    'Prend la plus grande valeur des 5 colonnes prix
    Range("Q:Q" & DerLig).Copy Range("R1") 'on copie la plage de cellules de la colonne Q vers la colonne R

    For i = DerLig To 5 Step -1 ' de la dernière ligne en remontant vers la cinquième
        If Cells(i, 7).Value <> "MAISON" Then Rows(i).EntireRow.Delete  'Ne garde que la ligne où il est écrit MAISON ds la colonne nat cadastral
        If Cells(i, 2).Value = "" Then Rows(i).EntireRow.Delete 'Enleve tout ce qui est vide dans la colonne type d'acte 
        If Cells(i, 43).Value = 0 Then Rows(i).EntireRow.Delete  'Enleve tout ce qui n'a pas de superficie utile
    Next i

    Columns("C:C,H:H,K:Q,S:AC,AR:AR,AU:AU,AV:AV,AX:AX,AY:AY,AZ:AZ,BA:BA").Delete 'suppression des colonnes

    Range("B4:C4").Value = Array("TYPE", "DIV") 'application des titres
    Range("Q4:W4").Value = Array("NbrG", "CC", "NbSDB", "NbLog", "NbPH", "SB", "SU") 'application des titres

Vous pouvez voir que tous les "SELECT" ont disparu.

Prenez la bonne habitude de déclarer les variables en début de macro.

Autre remarque, il est inutile d'encadrer les commentaires avec des apostrophes, seule l'apostrophe en début de phrase suffit.

Essayez de simplifier votre code en vous inspirant de cet exemple.

Cdlt

Le 11/08/2021 à 18:22

Mercii Beaucoup pour votre aide et votre temps Arturo83 ! grâce à vous mes macros seront plus simple et rapide et merci Jean -Eric pour la solution que tu m'as apporté également .

Rechercher des sujets similaires à "comment executer formules substitute"