Extraire adresse en plusieurs colonne
Bonjour, j'ai une cellule adresse (en G2 par exemple, et en g3...), j'aimerai que la cellule qui contiens :
105 RUE DE VILLEMONTAIS 42300 ROANNE (par exemple),
soit décomposée en plusieurs cellules (le numéro, la rue, le CP, la ville), en bidouillant ca marche mais pas pour les adresses de ce type :
15 F RUE PEGERON 38200 VIENNE (le F pose alors soucis),
merci pour votre aide:)
Salut Maximus,
Force et Honneur !
Tout le problème de ce genre de souci, c'est... un fichier contenant TOUS les cas potentiels !
A+
Bonjour tout le monde,
Ce que je ferais :
- la liste de tous les types de voies trouvées dans mes adresses (RUE, ALLEE, PLACE, BOULEVARD, BD, AVENUE, AVE, COUR, etc.).
- la liste de tous mes codes postaux (en espérant qu'il n'y en aura pas en Grande Bretagne par exemple ou dans un pays qui mélange les chiffres et les lettres)
- spliter dans un 1er temps l'adresse, le code postal et le nom de la commune
- spliter dans un 2e temps l'adresse pour tenter d'isoler le n° qui peut être 15 F, 21 bis, 31-33, etc. le type de voie servant de séparateur.
De toute manière il y aura des exceptions, donc de la bidouille.
Si vous nous donnez une feuille avec juste les adresses (elles seront forcément anonymes), on pourra vous aider, sinon ce sera le doigt en l'air.
Bonjour, voici un fichier d'exemple, a noter que je préfèrerai des formules, même si cela doit nécessiter plusieurs étapes :)
Merciii.
Dans ce cas, laissons parler les spécialistes de la formule.
Bonsoir,
J'ouvre le bal pour les formuleurs !
Cdlt.
Salut maximus,
Salut l'équipe,
épatant, Jean-Eric
Ne voulant pas être en reste avec VBA, je me suis creusé la tête.
La solution que j'ai trouvée postule qu'aucun n° de maison ne comportera un élément de 2 lettres (en excluant aussi le slash "/"), chose que je n'ai personnellement jamais observée.
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%
'
Cancel = True
Application.ScreenUpdating = False
Columns("B:E").Delete shift:=xlToLeft
'
tTab = Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 2 To UBound(tTab, 1)
tTab(x, 1) = Replace(tTab(x, 1), " ", " ")
tSplit = Split(tTab(x, 1), " ")
For y = UBound(tSplit) - 1 To 0 Step -1
If IsNumeric(tSplit(y)) Then _
iIdx = y: _
tTab(x, 4) = tSplit(y): _
tTab(x, 5) = Right(tTab(x, 1), Len(tTab(x, 1)) - InStr(tTab(x, 1), tSplit(y + 1)) + 1): _
Exit For
Next
For y = 0 To iIdx - 1
If Len(tSplit(y)) > 1 And (Not IsNumeric(Left(tSplit(y), 1)) And Not IsNumeric(Right(tSplit(y), 1)) And InStr(tSplit(y), "/") = 0) Then _
tTab(x, 2) = Left(tTab(x, 1), InStr(tTab(x, 1), tSplit(y)) - 2): _
tTab(x, 3) = Mid(tTab(x, 1), InStr(tTab(x, 1), tSplit(y)), InStr(tTab(x, 1), tSplit(iIdx)) - InStr(tTab(x, 1), tSplit(y))): _
Exit For
Next
Next
Range("A1").Resize(UBound(tTab, 1), 5).Value = tTab
Columns(2).HorizontalAlignment = xlHAlignRight
Columns.AutoFit
'
Application.ScreenUpdating = True
'
End Sub
A+
Bonjour toute l'équipe,
Si VBA a le droit d'asile, alors une autre proposition. Certaines adresses ne sont pas prises en compte (quelques unes), mais je ne voudrais pas perdre trop de temps sur un code qui ne servira probablement pas (si VBA non souhaité).
Salut Maximus,
Salut les as,
@Optimix : un joli code inutile pour l'un peut être très utile pour d'autres !
Après réflexion, il peut arriver qu'un élément de 2 lettres et + se faufile dans la numérotation d'une maison, genre "10 Bloc 1" ou "10 Allée A" (les 2 premières adresses du fichier joint sont libellées de la sorte).
Combiné à un nom de rue en 1 mot, le calcul devient vite tordu, aussi ai-je modifié ma macro. Sans doute faudrait-il prévoir dans ces cas-là une colonne supplémentaire, pour la beauté du geste.
Au-delà, sauf réception d'exemples plus concrets d'adresses bizarroïdes, je cale un peu.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tSplit, iIdx%
'
Cancel = True
Application.ScreenUpdating = False
Columns("B:E").Delete shift:=xlToLeft
'
tTab = Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 2 To UBound(tTab, 1)
tTab(x, 1) = Replace(tTab(x, 1), " ", " ")
tSplit = Split(tTab(x, 1), " ")
For y = 1 To 2
For Z = IIf(y = 1, UBound(tSplit) - 1, 0) To IIf(y = 1, 0, iIdx - 1) Step IIf(y = 1, -1, 1)
If y = 1 And IsNumeric(tSplit(Z)) Then _
iIdx = Z: _
Exit For
If y = 2 And Len(tSplit(Z)) > 1 And _
(Not IsNumeric(Left(tSplit(Z), 1)) And Not IsNumeric(Right(tSplit(Z), 1)) And InStr(tSplit(Z), "/") = 0) And _
((Not IsNumeric(Left(tSplit(Z + 1), 1)) And Not IsNumeric(Right(tSplit(Z + 1), 1)) And _
InStr(tSplit(Z + 1), "/") = 0 And Len(tSplit(Z + 1)) > 1) Or Z + 1 = iIdx) Then _
tTab(x, 2) = Left(tTab(x, 1), InStr(tTab(x, 1), tSplit(Z)) - 2): _
tTab(x, 3) = Mid(tTab(x, 1), InStr(tTab(x, 1), tSplit(Z)), InStr(tTab(x, 1), tSplit(iIdx)) - InStr(tTab(x, 1), tSplit(Z))): _
tTab(x, 4) = tSplit(iIdx): _
tTab(x, 5) = Right(tTab(x, 1), Len(tTab(x, 1)) - InStr(tTab(x, 1), tSplit(iIdx + 1)) + 1): _
Exit For
Next
Next
Next
Range("A1").Resize(UBound(tTab, 1), 5).Value = tTab
Columns(2).HorizontalAlignment = xlHAlignRight
Columns.AutoFit
'
Application.ScreenUpdating = True
'
End Sub
A+
Bonjour à toutes et tous,
Je me joins à vous
@maximus45, n'a plus qu'a donner son avis en tout cas le choix est là.
Cordialement.
Salut l'équipe,
aussitôt pensé, aussitôt fait, je décortique éventuellement la numérotation comme décrit dans mon précédent post en 2 colonnes.
À tester sur une multitude d'adresses, bien sûr..
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tSplit, iIdx%
'
Cancel = True
Application.ScreenUpdating = False
Columns("B:F").Delete shift:=xlToLeft
'
tTab = Range("A1:F" & Range("A" & Rows.Count).End(xlUp).Row).Value
For x = 2 To UBound(tTab, 1)
tTab(x, 1) = Replace(tTab(x, 1), " ", " ")
tSplit = Split(tTab(x, 1), " ")
For y = 1 To 2
For Z = IIf(y = 1, UBound(tSplit) - 1, 0) To IIf(y = 1, 0, iIdx - 1) Step IIf(y = 1, -1, 1)
If y = 1 And IsNumeric(tSplit(Z)) Then _
iIdx = Z: _
Exit For
If y = 2 And Len(tSplit(Z)) > 1 And _
(Not IsNumeric(Left(tSplit(Z), 1)) And Not IsNumeric(Right(tSplit(Z), 1)) And InStr(tSplit(Z), "/") = 0) And _
((Not IsNumeric(Left(tSplit(Z + 1), 1)) And Not IsNumeric(Right(tSplit(Z + 1), 1)) And _
InStr(tSplit(Z + 1), "/") = 0 And Len(tSplit(Z + 1)) > 1) Or Z + 1 = iIdx) Then
tTab(x, 2) = Left(tTab(x, 1), InStr(tTab(x, 1), tSplit(Z)) - 2)
tTab(x, 4) = Mid(tTab(x, 1), InStr(tTab(x, 1), tSplit(Z)), InStr(tTab(x, 1), tSplit(iIdx)) - InStr(tTab(x, 1), tSplit(Z)))
tTab(x, 5) = tSplit(iIdx)
tTab(x, 6) = Right(tTab(x, 1), Len(tTab(x, 1)) - InStr(tTab(x, 1), tSplit(iIdx + 1)) + 1)
tSplit = Split(tTab(x, 2), " ")
If UBound(tSplit) > 1 Then
For k = 0 To UBound(tSplit) - 1
If Len(tSplit(k)) > 1 And _
(Not IsNumeric(Left(tSplit(k), 1)) And Not IsNumeric(Right(tSplit(k), 1)) And InStr(tSplit(k), "/") = 0) Then _
tTab(x, 3) = Right(tTab(x, 2), Len(tTab(x, 2)) - InStr(tTab(x, 2), tSplit(k)) + 1): _
tTab(x, 2) = Left(tTab(x, 2), InStr(tTab(x, 2), tSplit(k)) - 2): _
Exit For
Next
End If
Exit For
End If
Next
Next
Next
Range("A1").Resize(UBound(tTab, 1), 6).Value = tTab
Columns(2).HorizontalAlignment = xlHAlignRight
Columns.AutoFit
'
Application.ScreenUpdating = True
'
End Sub
A+
Bonjour à tous
Il s'agit d'un multipost, quasi simultané, et de part et d'autre on attend toujours le demandeur
Sans doute parti en we pendant que nous bossons sur sa demande...
https://www.excel-downloads.com/threads/separer-adresse-en-4-elements.20059505/
Re toutes et tous,
@78chris,
@maximus45 a intérêt à avoir de sacrés bons arguments lors de sa critique positive et / ou négative de l'une ou l'autre de nos propositions.
A moins qu'il ne se contente d'un simple "Merci à tous" ou pas !
Bonjour à tous,
@78chris
N'étant pas inscrit sur l'autre forum et ne pouvant donc pas télécharger le fichier, je serais intéressé par la solution PowerQuery
Dans l'hypothèse où Chris sur excel-download est le même qu'ici...
RE
@78chrisN'étant pas inscrit sur l'autre forum et ne pouvant donc pas télécharger le fichier, je serais intéressé par la solution PowerQuery
Serais-tu d'accord pour la partager ici ?
let
Source = Excel.CurrentWorkbook(){[Name="Adresses"]}[Content],
#"Personnalisée ajoutée" = Table.AddColumn(Source, "N°", each if Text.Length(Text.BeforeDelimiter([Adresse]," ",1))-2=Text.Length(Text.BeforeDelimiter([Adresse]," ")) then Text.BeforeDelimiter([Adresse]," ",1) else Text.BeforeDelimiter([Adresse]," ")),
#"Personnalisée ajoutée1" = Table.AddColumn(#"Personnalisée ajoutée", "Inverse", each Text.Reverse([Adresse])),
#"Diviser la colonne selon les transitions de caractères" = Table.SplitColumn(#"Personnalisée ajoutée1", "Inverse", Splitter.SplitTextByCharacterTransition((c) => not List.Contains({"0".."9"}, c), {"0".."9"}), {"Adresse.1", "Adresse.2"}),
#"Fractionner la colonne par position" = Table.SplitColumn(#"Diviser la colonne selon les transitions de caractères", "Adresse.2", Splitter.SplitTextByPositions({0, 5}, false), {"CP0", "Adresse.2.2"}),
#"Personnalisée ajoutée2" = Table.AddColumn(#"Fractionner la colonne par position", "CP", each Text.Reverse([CP0])),
#"Personnalisée ajoutée3" = Table.AddColumn(#"Personnalisée ajoutée2", "Rue", each Text.Trim(Text.BetweenDelimiters([Adresse],[#"N°"],[CP]))),
#"Personnalisée ajoutée4" = Table.AddColumn(#"Personnalisée ajoutée3", "Ville", each Text.Trim(Text.AfterDelimiter([Adresse],[CP]))),
#"Colonnes supprimées" = Table.RemoveColumns(#"Personnalisée ajoutée4",{"Adresse.1", "Adresse.2.2", "CP0"}),
#"Colonnes permutées" = Table.ReorderColumns(#"Colonnes supprimées",{"Adresse", "N°", "Rue", "CP", "Ville"}),
#"Type modifié" = Table.TransformColumnTypes(#"Colonnes permutées",{{"Adresse", type text}, {"N°", type text}, {"Rue", type text}, {"CP", type text}, {"Ville", type text}})
in
#"Type modifié"Bonjour à tous,
J'ai complété mon code en VBA qui donne le même tableau que Power Query, mais ce n'est pas désintéressé
Je remercie au passage 78chris pour ce fichier auquel je n'avais pas non plus accès.
Est-ce que quelqu'un pourrait nous fournir le code M de Power Query ou nous dire comment il faut s'y prendre ? Est-ce qu'il y a un tuto sur le sujet sur EP ?
Bonjour
Est-ce que quelqu'un pourrait nous fournir le code M de Power Query ou nous dire comment il faut s'y prendre ? Est-ce qu'il y a un tuto sur le sujet sur EP ?
J'ai ajouté le code M
A noter que le split de la ligne
#"Diviser la colonne selon les transitions de caractères" = Table.SplitColumn(#"Personnalisée ajoutée1", "Inverse", Splitter.SplitTextByCharacterTransition((c) => not List.Contains({"0".."9"}, c), {"0".."9"}), {"Adresse.1", "Adresse.2"}),utilise une possibilité de 365. J'ignore si elle a été ajouté sur 2016.
C'est OK sur 2019 à jour
Sur toutes les versions on peut utiliser
soit
let
Source = Excel.CurrentWorkbook(){[Name="Adresses"]}[Content],
#"Personnalisée ajoutée" = Table.AddColumn(Source, "N°", each if Text.Length(Text.BeforeDelimiter([Adresse]," ",1))-2=Text.Length(Text.BeforeDelimiter([Adresse]," ")) then Text.BeforeDelimiter([Adresse]," ",1) else Text.BeforeDelimiter([Adresse]," ")),
#"Personnalisée ajoutée1" = Table.AddColumn(#"Personnalisée ajoutée", "CP", each Text.End(Text.Replace(Text.Remove([Adresse],{"A".."z"})," ",""),5)),
#"Personnalisée ajoutée3" = Table.AddColumn(#"Personnalisée ajoutée1", "Rue", each Text.Trim(Text.BetweenDelimiters([Adresse],[#"N°"],[CP]))),
#"Personnalisée ajoutée4" = Table.AddColumn(#"Personnalisée ajoutée3", "Ville", each Text.Trim(Text.AfterDelimiter([Adresse],[CP]))),
#"Colonnes permutées" = Table.ReorderColumns(#"Personnalisée ajoutée4",{"Adresse", "N°", "Rue", "CP", "Ville"}),
#"Type modifié" = Table.TransformColumnTypes(#"Colonnes permutées",{{"Adresse", type text}, {"N°", type text}, {"Rue", type text}, {"CP", type text}, {"Ville", type text}})
in
#"Type modifié"let
Source = Excel.CurrentWorkbook(){[Name="Adresses"]}[Content],
#"Personnalisée ajoutée" = Table.AddColumn(Source, "N°", each if Text.Length(Text.BeforeDelimiter([Adresse]," ",1))-2=Text.Length(Text.BeforeDelimiter([Adresse]," ")) then Text.BeforeDelimiter([Adresse]," ",1) else Text.BeforeDelimiter([Adresse]," ")),
#"Personnalisée ajoutée1" = Table.AddColumn(#"Personnalisée ajoutée", "CP", each Text.End(Text.Select(Text.Replace([#"Adresse"]," ",""),{"0".."9"}),5)),
#"Personnalisée ajoutée2" = Table.AddColumn(#"Personnalisée ajoutée1", "Rue", each Text.Trim(Text.BetweenDelimiters([Adresse],[#"N°"],[CP]))),
#"Personnalisée ajoutée3" = Table.AddColumn(#"Personnalisée ajoutée2", "Ville", each Text.Trim(Text.AfterDelimiter([Adresse],[CP]))),
#"Colonnes permutées" = Table.ReorderColumns(#"Personnalisée ajoutée3",{"Adresse", "N°", "Rue", "CP", "Ville"}),
#"Type modifié" = Table.TransformColumnTypes(#"Colonnes permutées",{{"Adresse", type text}, {"N°", type text}, {"Rue", type text}, {"CP", type text}, {"Ville", type text}})
in
#"Type modifié"(versions optimisées)
Merci beaucoup, il n'y a plus qu'à essayer de digérer tout cela. Ca a l'air très efficace.
Bonjour à toutes et tous,
@78chris,
Le demandeur se fait toujours attendre, il doit chercher les mots pour nous remercier d'avoir apporté des solutions à son problème.
Bref, je me joins à @JB et @Optimix pour te remercier à mon tour pour les solutions avec Power Query et la pédagogie du post 17:12
Cordialement.