Autres comment extraire cp et ville d'une adresse dans excel 2007?

minipintade

XLDnaute Nouveau
Bonjour à tous,

meme si je sais que c'est surement super simple, je n'y arrive pas...meme en suivant des tutos

Voilà le probleme. J'ai dans une colonne une adresse complete ex: 12 rue de la paix 75000 Paris
Je souhaite extraire uniquement le code postal et la ville.

J'ai essayé d'utiliser convertir, en vain...

Quelle est la manière la plus simple de réaliser cette tache?

Merci beaucoup :)
 

dysorthographie

XLDnaute Occasionnel
bonjour,
VB:
Sub test()
MsgBox Cp("12 rue de la paix 75000 Paris")
End Sub
Function Cp(Ad As String) As String
Dim t, i As Integer
t = Split(Ad)
For i = 0 To UBound(t)
    If IsNumeric(t(i)) And Len(t(i)) = 5 Then
        Cp = t(i)
        Exit Function
    End If
Next
End Function

A affiner si le Nº de rue fait 5 caractère par exemple !
 

cp4

XLDnaute Accro
Bonjour minipintade:) , dysorthographie;), youky(BJ) ;),

Si j'ai bien compris extraire code postal et ville.
VB:
Sub test()
MsgBox CC_Ville("12 rue de la paix 75000 Paris")
End Sub

Function CC_Ville(c)
Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "\d{5}\s([A-Z,a-z,])+"
  Set a = obj.Execute(c)
  If a.Count > 0 Then CC_Ville = a(0) Else CC_Ville = ""
End Function
 

minipintade

XLDnaute Nouveau
Merci beaucoup pour vos réponses!

Je suis désolée d'avoir été aussi peu précise 😔

En fait mon fichier comporte 3 colonnes. L'adresse complète se situe dans la 3ème colonne la "C" sous la forme "12 rue de la paix 75000 Paris".

Je souhaiterais:
- couper dans la 3ème colonne le code postal et la ville
- pour la copier dans une 4ème colonne "D"

Donc dans notre exemple je souhaiterais avoir une colonne "C" 12 rue de la paix
une colonne "D" 75000 Paris

J'essaye de modifier les codes que vous m'avez envoyé mais j'arrive pas à grand chose 😞

Sauriez vous m'aider?

Merci beaucoup :) :) :)

Voilà ce que j'ai essayé de faire...
 
Dernière édition:

minipintade

XLDnaute Nouveau
ma piètre tentative..

VB:
Sub test()

MsgBox Cp(Columns("C:C").Select)

End Sub

Function Cp(Ad As String) As String

Dim t, i As Integer

t = Split(Ad)

For i = 0 To UBound(t)

    If IsNumeric(t(i)) And Len(t(i)) = 5 Then

        Cp = t(i)

        Exit Function

    Selection.Cut Destination:=Columns("C:C")

    Columns("D:D").Select

    End If

Next

End Function
 

patricktoulon

XLDnaute Barbatruc
bonjour
colle ça dans un module
adapte le nom de la feuille
et lance la sub test2
VB:
Function CDE_P_VIlle(txt As String)
    With CreateObject("Vbscript.regexp")
        .Pattern = "\d{5}\s\D+$"
        Set a = .Execute(CStr(txt))
        If a.Count > 0 Then CDE_P_VIlle = a(0) Else CDE_P_VIlle = ""
    End With
End Function

Sub test2()
    Set plage = Feuil1.Range("c1:c" & Cells(Rows.Count, "C").End(xlUp).Row)
    For Each cel In plage.Cells
        cpville = CDE_P_VIlle(cel.Value)
        cel.Offset(, 1) = cpville
        cel.Value = Split(cel.Value, cpville)(0)
    Next
End Sub
 

dysorthographie

XLDnaute Occasionnel
VB:
Type Adrs
    Adresse As String
    Cp As String
    ville As String
End Type

Sub test2()
Dim ad As Adrs, cel As Range
    Set plage = Feuil2.Range("c1:c" & Cells(Rows.Count, "C").End(xlUp).Row)
 
    For Each cel In plage.Cells
    ad = Cp(cel.Value)
    cel = ad.Adresse
    cel.Offset(0, 1) = ad.Cp & " " & ad.ville
    Next
End Sub
Function Cp(ad As String) As Adrs
Dim t, i As Integer
Dim ville As Boolean
t = Split(ad)
For i = UBound(t) To 0 Step -1
    If IsNumeric(t(i)) And Len(t(i)) = 5 Then
       Cp.Cp = t(i)
       ville = True
     Else
     If ville = False Then
        Cp.ville = t(i) & " " & Cp.ville
     Else
         Cp.Adresse = t(i) & " " & Cp.Adresse
     End If
    End If
Next
End Function
 
Dernière édition:
Haut Bas