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 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 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
A voir également:

5 réponses

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
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 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
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 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
17 mai 2011 à 13:29
Okay, compris, je regarde...
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
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 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
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