Cette fonction sépare des adresses en plusieurs colonnes dans beaucoup de configurations.
Elle permet de sélectionner avec ou sans boite postale, d'afficher avec ou sans boite postale.
Les libellés des adresses peuvent indifféremment êtres au format,
12 tolbiac 75005 PARIS
12 Rue des Egletières BP 100 75008 PARIS
12 rue tolbiac 75005 PARIS
12 Rue des Egletières BP 100 75008 PARIS
12 Egletières BP 100 75008 PARIS
12 Rue Egletières BP 100 75008 PARIS
Résultat avec la BP sélectionnée et inversion de la rue et du numéro
Résultat sans la BP et sans inversion de colonnes
Les différentes options sont commentées dans le code.
Code
A mettre dans un module public.
Option Explicit
Sub SepareAdresse()
Dim WkSource As Worksheet, WkDest As Worksheet
Dim Colsource As Integer, LigSource As Integer, Lig As Long, UB As Byte
Dim ColDest As Integer, LigDest As Long, TB, i As Integer, e As Integer
Dim OrdreDest()
Set WkSource = Sheets("Feuil1") 'Feuille où se trouve les adresses à séparer
'Note : si les adresses sont dans un autre classeur vous pouvez initialiser par
'Set WkSource = Workbooks("ClasseurSource.xls").Sheets("Feuil1")
Colsource = 2 'colonne où se trouve les adresses à séparer - ici "B"
LigSource = 4 'Première ligne où se trouve les adresses à séparer - ici "4"
Set WkDest = Sheets("Feuil2") 'Feuille où mettre les données séparées
'Note : si les destinations sont dans un autre classeur vous pouvez initialiser par
'Set WkDest = Workbooks("ClasseurDest.xls").Sheets("Feuil2")
ColDest = 3 'Première colonne où mettre les adresses séparées - ici "C"
LigDest = 3 'Première ligne où mettre les adresses séparées
'Changer l'ordre des cellules
'Exemple pour avoir
'rue des Abeilles | 143 | Bt 3 | 65677 | LaVille
OrdreDest = Array(1, 0, 2, 3, 4)
'Dans l'exemple nous ne modifierons pas l'ordre des colonnes,
'Si il y a des adresses avec et sans boite postale, sélectionnez 4 colonnes
OrdreDest = Array(0, 1, 2, 3, 4)
'S'il n' y a jamais de BP, mettre une colonne en moins
'OrdreDest = Array(0, 1, 2, 3)
With WkSource
For Lig = LigSource To .Cells(65536, Colsource).End(xlUp).Row
On Error GoTo Erreur ' au cas où une adresse serait invalide
TB = Split(.Cells(Lig, Colsource), " ")
UB = UBound(TB)
For i = 1 To UB
If Not IsNumeric(TB(i + 1)) Then
If i > 1 Then TB(1) = TB(1) & " " & TB(i)
Else
Exit For
End If
Next i
If UBound(TB) < 4 Then
ReDim Preserve TB(4)
TB(4) = TB(3): TB(3) = TB(2)
End If
If TB(i + 1) < 300 Then 'il y a une boite postale
If UBound(OrdreDest) = 4 Then
TB(2) = TB(i) & " " & TB(i + 1)
TB(3) = TB(i + 2): TB(4) = TB(i + 3)
Else 'mais il ne faut pas l'afficher
TB(2) = TB(UBound(TB) - 1): TB(3) = TB(UBound(TB))
End If
Else ' pas de boite postale
If i > 1 Then TB(1) = TB(1) & " " & TB(i)
If UBound(OrdreDest) = 4 Then 'la BP est optionnelle mais n'est pas présente
TB(2) = ""
TB(3) = TB(UBound(TB) - 1): TB(4) = TB(UBound(TB))
Else
TB(2) = TB(UBound(TB) - 1): TB(3) = TB(UBound(TB))
End If
End If
For e = 0 To UBound(OrdreDest)
WkDest.Cells(LigDest, ColDest).Offset(, OrdreDest(e)) = TB(e)
Next e
LigDest = LigDest + 1
Passe:
Next Lig
End With
Exit Sub
Erreur:
Resume Passe
End Sub
Remarque
Au cas ou vous auriez une configuration de l'adresse qui n'est pas reprise dans cet exemple veuillez mettre un commentaire avec l'exemple de l'adresse à prendre en compte, je verrais pour l'adjoindre à la fonction.
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
