Bonjour à tous,
Je sollicite votre aide pour trouver une macro capable de séparer par colonne une adresse du type :
M TRUQUE NATHANEL SYLVESTRE RUPERT 0012 IMPASSE DU SENS UNIQUE 27040 FAINFOND
Pour l'instant j'essaye avec cette logique (qui est une formule qui ne fonctionne pas encore ) :
Sub Extraire_ADRESSES_CODESPOSTAUX_VILLES()
Dim c As Range, t As Integer
Set c = Range("A2")
Do While c <> ""
For t = InStr(InStr(c, " "), c, " ") To Len(c)
Select Case Mid(c, t, 1)
Case "0" To "9"
Exit For
End Select
Next t
c(1, 2) = Mid(c, 1, t - 2)
c(1, 3) = Mid(c, t, 500)
Set c = c(2, 1)
Loop
End Sub
Private Sub CommandButton1_Click()
iR = Cells(65535, 1).End(xlUp).Row
For i = 1 To iR
Codep = ADCOD(Cells(i, 1))
iPos = InStr(Cells(i, 1), Codep)
Cells(i, 2) = Left(Cells(i, 1), iPos - 1)
Cells(i, 3) = Codep
Cells(i, 4) = Mid(Cells(i, 1), iPos + 6)
Next
End Sub
Private Function ADCOD(c)
Application.Volatile
Set obj = CreateObject("vbscript.regexp")
obj.Pattern = "\d{5}"
Set a = obj.Execute(c)
If a.Count > 0 Then ADCOD = a(0) Else codepostal = ""
End Function
Pouvez vous, s'il vous plait, me dire comment faire en sorte qu'elle fonctionne?
En vous remerciant par avance,
Bien cordialement
Midou
Je sollicite votre aide pour trouver une macro capable de séparer par colonne une adresse du type :
M TRUQUE NATHANEL SYLVESTRE RUPERT 0012 IMPASSE DU SENS UNIQUE 27040 FAINFOND
Pour l'instant j'essaye avec cette logique (qui est une formule qui ne fonctionne pas encore ) :
Sub Extraire_ADRESSES_CODESPOSTAUX_VILLES()
Dim c As Range, t As Integer
Set c = Range("A2")
Do While c <> ""
For t = InStr(InStr(c, " "), c, " ") To Len(c)
Select Case Mid(c, t, 1)
Case "0" To "9"
Exit For
End Select
Next t
c(1, 2) = Mid(c, 1, t - 2)
c(1, 3) = Mid(c, t, 500)
Set c = c(2, 1)
Loop
End Sub
Private Sub CommandButton1_Click()
iR = Cells(65535, 1).End(xlUp).Row
For i = 1 To iR
Codep = ADCOD(Cells(i, 1))
iPos = InStr(Cells(i, 1), Codep)
Cells(i, 2) = Left(Cells(i, 1), iPos - 1)
Cells(i, 3) = Codep
Cells(i, 4) = Mid(Cells(i, 1), iPos + 6)
Next
End Sub
Private Function ADCOD(c)
Application.Volatile
Set obj = CreateObject("vbscript.regexp")
obj.Pattern = "\d{5}"
Set a = obj.Execute(c)
If a.Count > 0 Then ADCOD = a(0) Else codepostal = ""
End Function
Pouvez vous, s'il vous plait, me dire comment faire en sorte qu'elle fonctionne?
En vous remerciant par avance,
Bien cordialement
Midou