déconcaténer adresse postale

'découper une adresse du type :
'52 rue du 54ème Faugbourg 10200 BAR sur AUBE
'en 4 morceaux (n°, rue, CP, ville)
Sub DecoupeCell()
Dim cell As Range, Tablo, res
Application.ScreenUpdating = False
On Error Resume Next
For Each cell In Selection
Tablo = Split_97(cell.Text, " "): res = ""
For i = LBound(Tablo) To UBound(Tablo)
If IsNumeric(Tablo(i)) Then Tablo(i) = "*" & Tablo(i) & "*"
res = res & Tablo(i) & " "
Next
Tablo = Split_97(Right(res, Len(res) - 1), "*")
For i = LBound(Tablo) To UBound(Tablo)
Tablo(i) = Trim(Tablo(i))
Next
cell(, 2).Resize(, UBound(Tablo) + 1).Formula = Tablo
Next
Selection.Resize(, UBound(Tablo) + 1).Columns.AutoFit
End Sub
Function Split_97(Chaine$, Separateur$)
'FS, mpfe (renvoie un tableau de base 0)
Dim Tablo(), pos%, S$
S = Trim(Chaine): ReDim Tablo(0)
Recurse:
pos = InStr(1, S, Separateur)
If pos = 0 Then
Tablo(UBound(Tablo)) = S
Split_97 = Tablo()
Exit Function
Else
Tablo(UBound(Tablo)) = Left(S, pos - 1)
S = Right(S, Len(S) - pos)
ReDim Preserve Tablo(UBound(Tablo) + 1)
GoTo Recurse
End If
End Function

Cliquez pour agrandir...