Microsoft 365 [Résolu] Separer Nom, Ligne d'adresse, Cp et Ville en VBA

[McMidou84]

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

 

[Staple1600]

Re

Le lien n'était qu'un exemple pris au hasard
Juste là pour inviter (de manière subliminale) le demandeur à utiliser cet outil trop souvent délaissé

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

 

[GALOUGALOU]

bonsoir le fil
ce message s'adresse à patricktoulon
j'ai mis à l'épreuve ton classeur initial a une base de données reélle de 543 occurrences. (confidentielle)
le classeur a retourné 541 occurrences de manière parfaite (et pourtant toutes les adresses n'étaient pas normalisées parfaitement.
seulement 2 erreurs autant dire une misère
un petit commentaire en plus
en france dans toutes les entreprises qui réalise un tri mécanisé du courrier, ( traitement qui s'appuie sur un logiciel informatique) entraine toujours des rejets. La perfection n'existe pas
cordialement
galougalou

 

[jmfmarques]

Bonjour GALOUGALOU

dans toutes les entreprises qui réalise un tri mécanisé du courrier, ( traitement qui s'appuie sur un logiciel informatique) entraine toujours des rejets. La perfection n'existe pas

Hola ! Je ne peux rester sans réaction.
Qu'entends-tu par "traitement qui s'appuie sur un logiciel informatique " pour "réaliser un tri mécanisé du courrier" ? Heu ...
Une entreprise sérieuse ne se trouve jamais dans la situation qui est celle de cette discussion (tenter d'éclater de manière normalisée des adresses saisies "en vrac"). Elle fait ce qu'il convient de faire avant tout développement : elle passe le temps nécessaire (indispensable) à la modélisation des données. Il s'agit là d'un minimum vital.
Tenter de se raccrocher ensuite aux branches relève purement et simplement de l'amateurisme.

 

[Staple1600]

Re, Bonsoir GALOUGALOU

Puisque nous sommes sur un forum public, les messages sont lisibles par tous
Alors la perfection n'existe pas, certes (et fort heureusement d'ailleurs)
Mais ceux* qui tendent vers elle n'utilisent pas Excel, ni VBA
Pour ceux qui ont des sous dans leurs poches

* : Les ceusses qui font de la RNVP

EDITION:
Je n'avais pas vu passé jmfmarques (Bonsoir)

 

[GALOUGALOU]

bonsoir le fil
allons à l'essentiel
je me suis peut-être mal exprimé, mais je trouve le classeur de patricktoulon remarquable et le résultat qu'on obtient avec , est assez exceptionnel.
galougalou

 

[patricktoulon]

re
moi non plus je ne peux rester sans réagir

qui a dit que mon but était de travailler des adresses en vrac ??
je traite seulement des adresse dans un format bien précis qui contient des sous ensembles de formats ayant des petites divergences quand a l'ordre des mots ou le commencement par num ou char grâce au groupe de subpatterns conditionels

c'est tout et ça fonctionne

le cas échéant ajouter les expressions dans les sous groupes respectifs

il est certains que toutes les chaines ne vont pas passer

en tout cas j'ai cherché et pas trouvé mieux

beaucoup ce cantonnent a xxx rue truc xxxxx ville

j'ai simplement élargie ce format en donnant la possibilité au regex de taper
ordre et désordre et nuances DANS LES SOUS ENSEMBLES!!!!

 

[Staple1600]

Re

bonsoir le fil
allons à l'essentiel

On est d'accord
Sauf que pour moi l'essentiel serait de savoir pourquoi il faut séparer le contenu de cette colonne.
Et il s'agit de publipostage, alors on devrait aller au plus simple, non ?

 

[McMidou84]

Bonjour et merçi a tous !

Cette formule ne fonctionne pas !

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, 5) c(1, 3).NumberFormat = "00000"
c(1, 4) = Mid(c, t + 6)
Set c = c(2, 1)
Loop
End Sub

Ca bug a cette ligne :

c(1, 3) = Mid(c, t, 5) c(1, 3).NumberFormat = "00000"

Quelqu'un saurait me dire pourquoi svp?

Merci par avance

 

[patricktoulon]

bonjour
relis tout le post tranquillement tu comprendra tout seul pourquoi
j'ajouterais que le "while c<>""" n'a ni queue ni sens
d'autant plus que c devient un tableau dans le code alors que c'est un range au depart "A2"
et que ta boucle s'arrête au 1 er numérique donc code postal walou walouh!!!

 

[McMidou84]

Merçi

 

[patricktoulon]

une adresse c'est
[civilité ou pas]
[nom prenom ou pas]
[N° de rue/chemin/etc... ou pas]
[ reste de l'adresse]
[code postal]
[ville]
[département ou pas]
[pays ou pas]

le ou pas veut dire que toute routine avec une boucle sur un numérique peut tomber sur le N° ou le code postal
et en plus si le numéro est composé lui aussi de 5 chiffre ben va choisir le quel est le bon
d'autant plus que les adresses sont parfois un peu nuancées( dans leur ordre de chaine$ )

donc avec une routine vba le % de véracité des résultat dépendra du bon format de l'adresse

par contre avec un regex on peu aller légèrement plus loin même si on n'est pas a l'abri que lui aussi ai des ratés

en tout ça c'est moins compliqué a coder dans une routine
tu a des propositions dans ce post il ne te reste plus qu'a lire

 

[McMidou84]

re
Bonjour le fil
bon ben je me suis un peu amusé moi aussi

'*************************************************
'décanté une addresse au format:
'[civilité], [nom et ou prenom],[adresse],[codepostal],[ville])
' patricktoulon exceldownload
'version 1.0
'Date version:28/02/2020
' s'utilise en formule ou en VBA
'**************************************************

Option Explicit
Public Function GlobalRegex1(cel As String, Argu As String) As String
   Dim Matches, ccp&, temp$
   Application.Volatile
    With CreateObject("vbscript.regexp")
        .Global = True: .IgnoreCase = True
        Select Case Argu
            '--------------------------------------------------------------------------------------
        Case "civilité"
            .Pattern = "^(mr\s(et|ou)\smme\s|mr\s|melle\s|m.\s|m\s|mme\s|dr\s|docteur\s)"    ' doit commencer par
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then GlobalRegex1 = Trim(Matches(0))
            '--------------------------------------------------------------------------------------
        Case "adresse"
            ccp = GlobalRegex1(cel, "codepostal")
            .Pattern = "(\d{5})"    'tout jusqu'a une chaine de 5 chiffre
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then temp = Mid(cel, 1, InStrRev(cel, Matches(Matches.Count - 1)) - 1)
            Debug.Print temp
            'on relance le regex pour ne recupérer la chaine qu'a partir d'un numero ou du nom commun (rue,chemin,etc....)
            'avec un pattern 2 options (xxxx abcdef...) ou ((rue/chemin/etc....) abcdefg....)
            Set Matches = Nothing
            .Pattern = "((\d{1,6})|rue|les|route|chemin|avenue|allée|allee|boulevard|impasse|place|lieu|résidence|residence|hameau|ferme|bar)"
            Set Matches = .Execute(CStr(temp))
            GlobalRegex1 = Mid(temp, InStr(1, temp, Matches(0)))
            '--------------------------------------------------------------------------------------
        Case "codepostal"
            .Pattern = " \d{5} "
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then GlobalRegex1 = Trim(Matches(Matches.Count - 1))

            '--------------------------------------------------------------------------------------
        Case "ville"
            .Pattern = " \d{5} .*$"
            Set Matches = .Execute(cel)
            If Matches.Count >= 1 Then GlobalRegex1 = Right(Matches(0), Len(Matches(0)) - 7)

            '--------------------------------------------------------------------------------------
        Case "nom"
            'peut se faire eventuellement avec SUBSTITUE dans les cells
            Dim z(1 To 4), I&: temp = cel
            z(1) = GlobalRegex1(cel, "civilité")
            z(2) = GlobalRegex1(cel, "codepostal")
            z(3) = GlobalRegex1(cel, "adresse")
            z(4) = GlobalRegex1(cel, "ville")
            For I = 1 To 4: temp = Replace(temp, z(I), ""): Next
            GlobalRegex1 = Trim(temp)
        End Select

    End With
End Function

ps: un petit rajout

.Pattern = "((\d{1,6})|rue|chemin|avenue|allée|allee|boulevard|impasse|place|route|lieu)"

Regarde la pièce jointe 1056755

M. ou Mme ne fonctionne pas !

 

[GALOUGALOU]

bonjour le fil
juste une remarque
pourtant sur #25 et #26 l'extraction est correcte.
cordialement
galougalou

 

[patricktoulon]

M. ou Mme ne fonctionne pas !

la bonne blague il n'y est pas dans le pattern


faut vraiment tout faire ici
et en plus a ce que je vois ca n'est pas la next version que tu a testé

bon je la redonne une dernière fois

'*************************************************
'décanté une addresse au format:
'[civilité], [nom et ou prenom],[adresse],[codepostal],[ville])
' patricktoulon exceldownload
'version 1.0
'Date version:28/02/2020
' s'utilise en formule ou en VBA
'**************************************************

'Option Explicit
' ajoutez eventuellement des expressions pour les address(|\sexpression\s|
Const addr As String = "\srue\s|\sles\s|\sle\s|\sroute\s|\schemin\s|\savenue\s|\sallée\s|\sallee\s|\sboulevard\s|\simpasse\s|\splace\s"
Const addr2 As String = "|\squartier\s|\slieu\s|\slotissement\s|résidence|residence|immeuble|\shameau\s|\sferme\s|bar\s"
'designation entreprise
Const addr3 As String = "|bijouterie\s|boulangerie\s|cabinet\s|\savocat\s"

Public Function GlobalRegex1(cel As String, Argu As String) As String
    If cel = "" Then Exit Function
    Dim Matches, ccp&, temp$
    Application.Volatile
    With CreateObject("vbscript.regexp")
        .Global = True: .IgnoreCase = True
        Select Case Argu
            '--------------------------------------------------------------------------------------
        Case "civilité"
            .Pattern = "^(mr\s(et|ou)\smme\s|m.\s(et|ou)\smme\s|mr\s|melle\s|mle\s|m.le\s|m.\s|m\s|mme\s|dr\s|docteur\s)"    ' doit commencer par
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then GlobalRegex1 = Trim(Matches(0))
            '--------------------------------------------------------------------------------------
        Case "adresse"
            ccp = GlobalRegex1(cel, "codepostal")
            .Pattern = "(\d{5})"    'tout jusqu'a une chaine de 5 chiffre
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then temp = Mid(cel, 1, InStrRev(cel, Matches(Matches.Count - 1)) - 1)
            Debug.Print temp
            'on relance le regex pour ne recupérer la chaine qu'a partir d'un numero ou du nom commun (rue,chemin,etc....)
            'avec un pattern 2 options (xxxx abcdef...) ou ((rue/chemin/etc....) abcdefg....)
            Set Matches = Nothing
            .Pattern = "((\d{1,6}) |" & addr & addr2 & addr3 & ")"
            Set Matches = .Execute(CStr(temp))
            GlobalRegex1 = Trim(Mid(temp, InStr(1, temp, Matches(0))))
            '--------------------------------------------------------------------------------------
        Case "codepostal"
            .Pattern = " \d{5} "
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then GlobalRegex1 = Trim(Matches(Matches.Count - 1))
            '--------------------------------------------------------------------------------------
        Case "ville"
            .Pattern = " \d{5} .*$"
            Set Matches = .Execute(cel)
            If Matches.Count >= 1 Then GlobalRegex1 = Right(Matches(0), Len(Matches(0)) - 7)
            '--------------------------------------------------------------------------------------
        Case "nom"
            'peut se faire eventuellement avec SUBSTITUE dans les cells
            Dim z(1 To 4), I&: temp = cel
            z(1) = GlobalRegex1(cel, "civilité")
            z(2) = GlobalRegex1(cel, "codepostal")
            z(3) = GlobalRegex1(cel, "adresse")
            z(4) = GlobalRegex1(cel, "ville")
            For I = 1 To 4: temp = Replace(temp, z(I), ""): Next
            GlobalRegex1 = Trim(temp)
        End Select
    End With
End Function

 

[McMidou84]

la bonne blague il n'y est pas dans le pattern


faut vraiment tout faire ici
et en plus a ce que je vois ca n'est pas la next version que tu a testé

bon je la redonne une dernière fois

'*************************************************
'décanté une addresse au format:
'[civilité], [nom et ou prenom],[adresse],[codepostal],[ville])
' patricktoulon exceldownload
'version 1.0
'Date version:28/02/2020
' s'utilise en formule ou en VBA
'**************************************************

'Option Explicit
' ajoutez eventuellement des expressions pour les address(|\sexpression\s|
Const addr As String = "\srue\s|\sles\s|\sle\s|\sroute\s|\schemin\s|\savenue\s|\sallée\s|\sallee\s|\sboulevard\s|\simpasse\s|\splace\s"
Const addr2 As String = "|\squartier\s|\slieu\s|\slotissement\s|résidence|residence|immeuble|\shameau\s|\sferme\s|bar\s"
'designation entreprise
Const addr3 As String = "|bijouterie\s|boulangerie\s|cabinet\s|\savocat\s"

Public Function GlobalRegex1(cel As String, Argu As String) As String
    If cel = "" Then Exit Function
    Dim Matches, ccp&, temp$
    Application.Volatile
    With CreateObject("vbscript.regexp")
        .Global = True: .IgnoreCase = True
        Select Case Argu
            '--------------------------------------------------------------------------------------
        Case "civilité"
            .Pattern = "^(mr\s(et|ou)\smme\s|m.\s(et|ou)\smme\s|mr\s|melle\s|mle\s|m.le\s|m.\s|m\s|mme\s|dr\s|docteur\s)"    ' doit commencer par
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then GlobalRegex1 = Trim(Matches(0))
            '--------------------------------------------------------------------------------------
        Case "adresse"
            ccp = GlobalRegex1(cel, "codepostal")
            .Pattern = "(\d{5})"    'tout jusqu'a une chaine de 5 chiffre
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then temp = Mid(cel, 1, InStrRev(cel, Matches(Matches.Count - 1)) - 1)
            Debug.Print temp
            'on relance le regex pour ne recupérer la chaine qu'a partir d'un numero ou du nom commun (rue,chemin,etc....)
            'avec un pattern 2 options (xxxx abcdef...) ou ((rue/chemin/etc....) abcdefg....)
            Set Matches = Nothing
            .Pattern = "((\d{1,6}) |" & addr & addr2 & addr3 & ")"
            Set Matches = .Execute(CStr(temp))
            GlobalRegex1 = Trim(Mid(temp, InStr(1, temp, Matches(0))))
            '--------------------------------------------------------------------------------------
        Case "codepostal"
            .Pattern = " \d{5} "
            Set Matches = .Execute(cel)
            If Matches.Count > 0 Then GlobalRegex1 = Trim(Matches(Matches.Count - 1))
            '--------------------------------------------------------------------------------------
        Case "ville"
            .Pattern = " \d{5} .*$"
            Set Matches = .Execute(cel)
            If Matches.Count >= 1 Then GlobalRegex1 = Right(Matches(0), Len(Matches(0)) - 7)
            '--------------------------------------------------------------------------------------
        Case "nom"
            'peut se faire eventuellement avec SUBSTITUE dans les cells
            Dim z(1 To 4), I&: temp = cel
            z(1) = GlobalRegex1(cel, "civilité")
            z(2) = GlobalRegex1(cel, "codepostal")
            z(3) = GlobalRegex1(cel, "adresse")
            z(4) = GlobalRegex1(cel, "ville")
            For I = 1 To 4: temp = Replace(temp, z(I), ""): Next
            GlobalRegex1 = Trim(temp)
        End Select
    End With
End Function

Tu assures merçi !!!!