Séparation numéro d'une adresse postal(Excel) [Résolu/Fermé]

Signaler
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012
 -
Messages postés
16450
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
12 mai 2021
 -
Bonjour,

Avant de poster ce message je tiens à précisé que je cherche une solution depuis 3j. j ai trouvé bon nombre de réponses mais pas encore la bonne.

Voila mon soucis,

je me retrouve avec un listing de 7000 contacts et je dois séparer les numéros de rue des adresses, j'avai trouvé une macro tip top qui me séparer la rue du numéro de tel que si j'avai

Ex:
COLONNE A

_Avenue Louise 137 Boîte 1
_Jaargetijdenlaan 110 B
_Square du Bastion 3

COLONNE B
_ 137 Boîte 1
_ 110 B
_ 3


C'été Nikel mais impossible de remettre la main dessus

Si quelqu'un à la réponse n'hesiter pas que je me colle cette macro sur le front

Encore merci

5 réponses

Réponse 1 / 5
Messages postés
16450
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
12 mai 2021
 3 172
Bonjour

Une proposition parmi d'autres possibles 

Function codepost(adresse As String) As String
Dim separe, cptr As Byte, cptr1 As Byte, retour As String
separe = Split(adresse)
For cptr = 0 To UBound(separe)
     If IsNumeric(separe(cptr)) Then Exit For
Next
For cptr1 = cptr To UBound(separe)
     retour = retour & " " & separe(cptr1)
Next
codepost = LTrim(retour)
End Function


et la macro pour les 7000 lignes 

Sub extraire_cp()
Dim derlig As Integer, texto As String, cptr As Integer
Dim liste
derlig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
liste = Application.Transpose(Range("A2:A" & derlig))

For cptr = 1 To UBound(liste)
    texto = liste(cptr)
     liste(cptr) = codepost(texto)
Next
Application.ScreenUpdating = False
Range("B2:B" & derlig) = Application.Transpose(liste)
End Sub
1
Merci
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Réponse 2 / 5
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012
Salut Michel,

je viens d'essayer, la macro fonctionne super bien mais ne prend pas le format "119A, 119-A"


Je te remercie pour ta réponse rapide et presque tip top c'est sympa

merci
Signaler
Messages postés
16450
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
12 mai 2021
 3 172
re,

peux tu expliquer; mais ne prend pas le format "119A, 119-A"

je me suis basé sur les 3 lignes que tu as donné ???
Signaler
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012
re

Colonne A:

Avenue Louise 381-383
Avenue Adolphe Buyl 110A

Colonne B:

Rien


Pour ce genre de format il me laisse une case vide

merci de ton aide Michel tu vas m'éviter un moment de galere :-)
Signaler
Messages postés
16450
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
12 mai 2021
 3 172
Okay, compris, je regarde...
Réponse 3 / 5
Messages postés
16450
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
12 mai 2021
 3 172
modifié en regardant si le 1° caractère de chaque mot commence par un chiffre 

Function codepost(adresse As String) As String
Dim separe, cptr As Byte, cptr1 As Byte, retour As String
separe = Split(adresse)
For cptr = 0 To UBound(separe)
     If IsNumeric(Left(separe(cptr), 1)) Then Exit For
Next
For cptr1 = cptr To UBound(separe)
     retour = retour & " " & separe(cptr1)
Next
codepost = LTrim(retour)
End Function
Réponse 4 / 5
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012
comment faite vous pour lancer la macro?

pour Sub extraire_cp()
Dim derlig As Integer, texto As String, cptr As Integer
Dim liste
derlig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
liste = Application.Transpose(Range("A2:A" & derlig))

For cptr = 1 To UBound(liste)
texto = liste(cptr)
liste(cptr) = codepost(texto)
Next
Application.ScreenUpdating = False
Range("B2:B" & derlig) = Application.Transpose(liste)
End Sub

j ai ouvert vba insertion - module - coller - rebasculer sous excel - macro - executer

mais la je ne vois pas

merci de votre patiente et encore merci
Réponse 5 / 5
Messages postés
16450
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
12 mai 2021
 3 172
Il faut coller la sub et la fonction dans un module
et sous Excel macro-executer

ou dans l'éditeur cliquer dans sub et F5

YTout à l'heure ca avait l'air de marcher puisque tu avais noté le problème des faux-chiffres....
Posez votre question