VBA récupérer des chaînes à partir d'un mot

Version imprimable

Bonsoir,

Je cherche à découper une adresse en isolant
dans une 1ère colonne le numéro
dans une 2ème colonne le type de voie (rue, avenue, etc)
et dans une 3ème colonne le nom de la voie (qui peut comporter plusieurs mots ex : du Général de Gaulle)

J'ai réussi à obtenir le résultat attendu pour les deux premières colonnes, mais ne parviens pas à remplir la troisième. En réalité, je pense ne pas avoir bien compris la manipulation de Split.
Le code suivant fonctionne donc très bien mais reste incomplet. Qui pourra me dire comment faire pour remplir la troisième colonne, aussi simplement que je l'ai fait avec les deux premières ?
A celui-là ou celle-là, d'avance, je dis : merci !
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub typeVoie() Dim compteur As Integer compteur = 3 Range("E3").Select While Not IsEmpty(ActiveCell.Offset(0, -4)) If ActiveCell.Offset(0, -4).Value Like "*rue*" Then ActiveCell.Formula = "rue" ActiveCell.Offset(0, -1) = Split(ActiveCell.Offset(0, -4), "rue") ElseIf ActiveCell.Offset(0, -4).Value Like "*avenue*" Then ActiveCell.Formula = "avenue" ActiveCell.Offset(0, -1) = Split(ActiveCell.Offset(0, -4), "avenue") ElseIf ActiveCell.Offset(0, -4).Value Like "*boulevard*" Then ActiveCell.Formula = "boulevard" ActiveCell.Offset(0, -1) = Split(ActiveCell.Offset(0, -4), "boulevard") End If Cells(compteur, 5).Select compteur = compteur + 1 Wend End Sub

22/10/2015, 00h37
kiki29

Salut, à lire : Manipuler les chaînes de caractères en VB6 et VBA Excel
22/10/2015, 00h57
kafountines

Bonsoir Kiki,

J'ai lu et relu et rerelu ce tuto qui, s'il est très complet et m'a bien aidée à résoudre beaucoup de choses, ne m'a pas permis de résoudre le problème posé ici.
C'est bien pour cela que j'ai posté.
J'ai également parcouru divers forums et n'ai toujours pas compris les subtilités du split qui est, je pense, la réponse à ma question.
Ou pour la formuler autrement : comment, à partir de Split, récupérer toutes les chaînes se trouvant à droite (ou après) la chaîne séparatrice ?

D'avance merci pour ton aide.
Je me suis embarquée dans vba il y a à peine deux semaines, je suis assez satisfaite de ce que j'ai pu en faire et époustouflée par toutes ces possibilités que j'avais jusqu'à présent ignorées, mais j'avoue que toutes ces recherches ont terriblement raccourci mes nuits et là, j'ai peine à réfléchir...

Bonjour,

Tu peux récupérer seulement l'élément que tu désire en indiquant sa place ordinale dans la chaîne (en base 0) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub Test()
 
    Dim Chaine As String
    Dim I As Integer
 
    Chaine = "Mr Dupont André 22 Rue du Général de Gaulle 75000 Paris"
 
    'tous les mots
    For I = 0 To UBound(Split(Chaine, " "))
 
        Debug.Print Split(Chaine, " ")(I)
 
    Next I
 
    'le mot "Général"
    Debug.Print Split(Chaine, " ")(6)
 
    'le dernier mot
    Debug.Print Split(Chaine, " ")(UBound(Split(Chaine, " ")))
 
End Sub

24/10/2015, 00h01
kafountines

Theze,

Merci de m'avoir répondu.
Cependant, je n'ai toujours pas saisis:calim2:
Je suis désolée !

Pour mieux comprendre mon problème, je le reformule :
j'ai une adresse complète du type 5 rue du Général de Gaulle
Je veux pouvoir mettre en A1 => 5
en B1 => rue
en C1=>du Général de Gaulle

Avec ton code, j'ai compris que chaque chaîne serait un élément d'un tableau
Dans ce cas, comme le nombre de chaîne varie d'une adresse à l'autre, comment faire pour connaître le nombre de chaînes généré par l'adresse ?
Par exemple, 5 rue du Général de Gaulle contient 6 chaînes, alors que 28 quai Gallieni n'en contient que 3.
Car dans mon cas, il faut que la première chaîne aille en A1, la seconde en B1 et tout le reste en C1. (Et je te passe le cas des numéros bis et ter)

Mon problème suivant est comment récupérer tout ça ?

Bref, je suis très très débutante et j'ai très très besoin de trouver une solution.

Au secours !
Merci d'avance pour ton aide...

Bonjour.
Code:

1 2 3 4 5 6 7 Sub Demo() For Each V In Split("5 rue du Général de Gaulle;28 quai Gallieni", ";") SP = Split(Replace(V, " ", "¤", , 2), "¤") MsgBox "Adresse : " & V & vbLf & vbLf & "Chaîne1 : " & SP(0) & vbLf & vbLf & _ "Chaîne2 : " & SP(1) & vbLf & vbLf & "Chaîne3 : " & SP(2) Next End Sub
_____________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

Bonjour,

Citation:

Dans ce cas, comme le nombre de chaîne varie d'une adresse à l'autre, comment faire pour connaître le nombre de chaînes généré par l'adresse ?
Par exemple, 5 rue du Général de Gaulle contient 6 chaînes,alors que 28 quai Gallieni n'en contient que 3.
Car dans mon cas, il faut que la première chaîne aille en A1, la seconde en B1 et tout le reste en C1. (Et je te passe le cas des numéros bis et ter)

La fonction Split renvoie un tableau et la fonction qui permet de savoir combien d'éléments, il y a dans un tableau est UBound
Exemple
Code:

1 2 3 4 5 6 7 8 9 10 Sub SplitMyString() Dim Txt$, myTable() As String, Elem As Byte Txt = Range("B2") myTable = Split(Txt) MsgBox "Il y a " & UBound(myTable) & " éléments dans la table" ' Affiche tous les éléments de la variable myTable For Elem = 0 To UBound(myTable) MsgBox myTable(Elem) Next End Sub

24/10/2015, 20h52
patricktoulon

Bonsoir

effectivement la on entre bien dans les expressions rationnelles si on prend en compte que les adresse avec leur len ou nombre de mots peuvent être diffèrent

si on considère que tes adresses commence toujours par un nombre de 1 ou X chiffres il faut que tu t'appuie au départ sur ca pour couper la partie ou il a le nom et l'autre ou il y a l'adresse

sans expression régulière et encore !!!!! tu ne pourra jamais disséquer correctement ta chaine Excel ou vba ne devine pas

je te suggère de regarder du coté de vbcript(regular.expression)

un indice pour toi
patern="( )+(D'\*)+( )" si on exécute ce patern dans l'object regular on doit trouver 2 matches 22 et 75000

je te laisse méditer sur ce point

re avec regular expression

re
voila je t'ai fait un exemple générique
tu a 4 adresses en demo elles fonctionnent toutes

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test()
 Dim chaine As String
 chaine = "Mr Dupont André 2222 Rue du Général de Gaulle 75000 Paris"
'chaine = "Mr trucbidule chouette  533 allée des maroniers  83242 toulon"
'chaine = "Mr machin  droledechose  02 boulevard des armaris 83520 la seyne sur mer"
'chaine = "Mr carton   mancheaabalais  55 quai  des derrieres retournés  83660 la lavalette du var"
mesdonnée = chainevalide(chaine, "( )+[0-9]+[0-9]+( )")
texte = " numero de l'adresse est  : " & mesdonnée(0) & vbCrLf
texte = texte & "l'adresse est : " & Split(Split(chaine, mesdonnée(0))(1), mesdonnée(1))(0)
MsgBox texte
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function chainevalide(txt As String, matrice, Optional cas = True) As Variant
    Dim Matches, ReG
    Set ReG = CreateObject("VBScript.RegExp")
    With ReG
        .Global = True: .Pattern = matrice: .IgnoreCase = cas
        Set Matches = .Execute(txt)
        ReDim tablo(Matches.Count): i = 0
        For Each Match In Matches
            tablo(i) = Trim(Match.Value)
            i = i + 1
        Next
    End With
    chainevalide = tablo
    Set ReG = Nothing
End Function

ps:
la commande générique fonctionne aussi

Code:

mesdonnée = chainevalide(chaine, "\d+")

Bonjour,

ci-joint à titre d'exemple quelques fonctions utilisant les expressions rationnelles.
Bien entendu certains patterns devront être complétés en fonction des cas de figure (ceux des fonctions TypeVoie et NomVoie) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Function TypeVoie(c) As String  
Dim oReg As Object, oMatches As Object
  Set oReg = CreateObject("vbscript.regexp")
  With oReg
    .ignorecase = True
    .Pattern = "(rue|avenue|quai|boulevard|impasse|voie)"'à compléter
    If .test(c) Then
      Set oMatches = .Execute(c)
      TypeVoie = oMatches.Item(0).Value
    End If
  End With
End Function
 
 
Function NomVoie(c) As String
  Dim oReg As Object, oMatches As Object
  Set oReg = CreateObject("vbscript.regexp")
  With oReg
    .ignorecase = True
    .Pattern = "(?:rue|avenue|quai|boulevard|impasse|voie)\s+([^\d]+)"'à compléter
    If .test(c) Then
      Set oMatches = .Execute(c)
      NomVoie = oMatches.Item(0).submatches(0)
    End If
  End With
End Function
 
 
Function CodePostal(c) As String
  Dim oReg As Object, oMatches As Object
  Set oReg = CreateObject("vbscript.regexp")
  With oReg
    .Pattern = "\d{5}"
    If .test(c) Then
      Set oMatches = .Execute(c)
      CodePostal = oMatches.Item(0).Value
    End If
  End With
End Function
 
 
Function Commune(c) As String
  Dim oReg As Object, oMatches As Object
  Set oReg = CreateObject("vbscript.regexp")
  With oReg
    .ignorecase = True
    .Pattern = "(?:\d{5}\s)([a-z,\s,-]+)"
    If .test(c) Then
      Set oMatches = .Execute(c)
      Commune = oMatches.Item(0).submatches(0)
    End If
  End With
End Function

A+

Les patterns des fonctions TypeVoie et NomVoie peuvent être simplifiées :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Function TypeVoie(c) As String  
Dim oReg As Object, oMatches As Object
  Set oReg = CreateObject("vbscript.regexp")
  With oReg
    .ignorecase = True
    '.Pattern = "(rue|avenue|quai|boulevard|impasse|voie)"
    .Pattern = "[a-z-]+"
    If .test(c) Then
      Set oMatches = .Execute(c)
      TypeVoie = oMatches.Item(0).Value
    End If
  End With
End Function
 
 
Function NomVoie(c) As String
  Dim oReg As Object, oMatches As Object
  Set oReg = CreateObject("vbscript.regexp")
  With oReg
    .ignorecase = True
    '.Pattern = "(?:rue|avenue|quai|boulevard|impasse|voie)\s+([^\d]+)"
    .Pattern = "(?:[a-z-]+)\s+([^\d]+)"
    If .test(c) Then
      Set oMatches = .Execute(c)
      NomVoie = oMatches.Item(0).submatches(0)
    End If
  End With
End Function

A+

25/10/2015, 11h45
patricktoulon

Re

Bonjour davido
Le premier exemple est inutile dans le sens ou en dur les arguments non pas besoins de pas passer par les expressions rationnelles

Ensuite le 2 eme manque d arguments car a-z te trouve chaque. mots

la. Solution la Plus proche est de trouver mes numeros comme je l ai montré et de spliter le texte a par tir de la

Code:

Rue=split(split(texte, numero1)(1), " ") (0)

En direct du phone perché sur le mont faron;)

Essai à développer et à tester d'une fonction unique permettant de découper une adresse en numéro de voie, type de voie, nom de voie, code postal et commune :
Code:

1 2 3 4 5 6 7 8 9 10 11 Function DecouperAdresse(c As String, N As Long) As String Dim oReg As Object, oMatches As Object Set oReg = CreateObject("vbscript.regexp") With oReg .Pattern = "(\d+)\s([a-z,-]+)\s([^\d]+)(\d{5})(.+)" If .test(c) Then Set oMatches = .Execute(c) DecouperAdresse = oMatches.Item(0).submatches(N - 1) End If End With End Function
Dans une feuille de calcul placer les adresses en colonne 1 et tester la fonction en la tirant vers la droite.
Quelques adresses testées :

Citation:

5 rue du Général de Gaulle 75010 Paris

28 quai Gallieni 84000 Avignon

29 boulevard de la motte-piquet 84000 Avignon

1 boulevard jacquemart andré 75008 clichy la garenne

1078 rond-point des champs élysées 75008 paris

A+

Je ne dis pas que c'est utile ni que l'on ne peut pas faire autrement, ni qu'il n'est pas plus judicieux de mixer un RegExp avec une autre possibilité de type Split, je teste simplement la possibilité de découper une adresse via l'utilisation d'une expression rationnelle.
Après c'est au demandeur d'explorer les différentes pistes proposées et d'avancer de son côté.

Citation:

Ensuite le 2 eme manque d arguments car a-z te trouve chaque. mots

et non justement (teste de ton côté !)...
A+

25/10/2015, 11h59
patricktoulon

La oui l idée est bonne avec les submatchs
Il faut donc dans le pattern un module numerique , un module mot et espace, unmodule plusieurmot plusieurs espaces

Re
Quand je dis inutile je veux dire q une simple boucle sur l'array fait le boulot
Et aussi parce que tu peut tres bien avoir
Rue, r., voie, Ve, impasse, Imp. Chemin, Ch. Etc.......
Dans n importe qule casavec des modules bien faits le submatchs donnerait le bon
1+pour les submatchs je n y avais pas pensé

Oui bien sûr l'array peut faire le travail, et même le Split d'ailleurs...après tout dépend des chaînes à traiter donc en fonction voir quelle est la meilleure solution.
Concernant l'utilisation d'une expression rationnelle dans le cas présent, et si les chaînes correspondent bien aux 2 exemples fournis par le demandeur, un RegExp peut suffire.
Pas besoin d'ailleurs de passer Global sur True (c'est d'ailleurs pour cela que la fonction initiale "TypeVoie" ne trouve qu'un seul mot et non tous les mots comme tu le pensais).
Par contre IgnoreCase=True est utile et allège le pattern.
Il peut être également utile de prévoir la suppression des espaces en trop de la chaîne à traiter au cas où plutôt que de prévoir ce cas de figure dans le pattern (très simple de le prévoir d'ailleurs mais bon...) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Function DecouperAdresse(c As String, N As Byte) As String Dim oReg As Object, oMatches As Object c = Application.WorksheetFunction.Trim(c)'au cas où Set oReg = CreateObject("vbscript.regexp") With oReg .ignorecase = True .Pattern = "^(\d+)\s([a-z,-]+)\s([^\d]+)(\d{5})\s(.+)$" If .test(c) Then Set oMatches = .Execute(c) DecouperAdresse = oMatches.Item(0).SubMatches(N - 1) End If End With Set oReg = Nothing: Set oMatches = Nothing End Function
A+

Au cas où l'adresse comporte des chiffres de type

Citation:

10 rue des 4 vents 34090 Montpelliers
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Function DecouperAdresse(c As String, N As Byte) As String Dim oReg As Object, oMatches As Object c = Application.WorksheetFunction.Trim(c) 'supprime les espaces superflus Set oReg = CreateObject("vbscript.regexp") With oReg .ignorecase = True .Pattern = "^(\d+)\s([a-z,-]+)\s(.+)(\d{5})\s(.+)$" If .test(c) Then Set oMatches = .Execute(c) DecouperAdresse = oMatches.Item(0).SubMatches(N - 1) End If End With Set oReg = Nothing: Set oMatches = Nothing End Function
A+

26/10/2015, 21h52
kafountines

Bonsoir à tous...
... et surtout un grand merci !

Pour une novice comme moi, malgré toute votre bonne volonté, je n'ai rien compris !
En revanche, j'ai fini par trouver la solution grâce à... limit

J'explique donc le truc finalement tout simple, pour celui ou celle qui un jour peut-être aura la même problématique :

Rappel : je voulais, à partir d'une adresse du type 6 rue du Général de Gaulle, obtenir le numéro 6 dans une cellule, le mot rue dans une autre et le reste, donc du général de gaulle dans une troisième.
Il suffit de préciser que l'on veut limiter le split à trois sous-chaînes.
Ce qui donne : Split("adressequejeveuxdecouper", " ", 3)
Et voilà !

Encore merci
Je commence à me détendre...
27/10/2015, 00h28
Marc-L

Félicitations ! :plusser:

Comme quoi lire l'aide s'avère payant ! Et dire que j'y avais pensé pour Replace sans vérifier pour Split ! :ptdr:
27/10/2015, 00h37
patricktoulon

re

re regarde dans tes MP

ensuite le split 3 fonction a partir du moment ou la premiere chaine est le numero

si ca commence du genre

Citation:

Mlle kafoutine de par labes 75 rue du forum excel vba 75000 panam

et bien c'est Walouh!!!

en reponse a ton mp je t'ai donné la solution en partant du principe que la rue/chemin ect... se trouve apres le nombre