Séparation numéro d'une adresse postal(Excel)

Résolu/Fermé
mathraxe
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012
- Modifié par mathraxe le 17/05/2011 à 09:31
michel_m
Messages postés
16569
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mai 2022
- 17 mai 2011 à 16:51
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

michel_m
Messages postés
16569
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mai 2022
3 280
17 mai 2011 à 10:42
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
mathraxe
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012

17 mai 2011 à 11:50
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
0
michel_m
Messages postés
16569
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mai 2022
3 280
17 mai 2011 à 11:59
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é ???
0
mathraxe
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012

17 mai 2011 à 13:09
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 :-)
0
michel_m
Messages postés
16569
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mai 2022
3 280
17 mai 2011 à 13:29
Okay, compris, je regarde...
0
michel_m
Messages postés
16569
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mai 2022
3 280
17 mai 2011 à 13:34
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
0
mathraxe
Messages postés
26
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
23 mai 2012

17 mai 2011 à 15:36
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
michel_m
Messages postés
16569
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mai 2022
3 280
17 mai 2011 à 16:51
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....
0