VBA Excel - Séparer une adresse postale dans plusieurs colonnes

Introduction

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.