Discussion :

[cha33]

Bonjour,

Je fais fasse à un petit soucis. Je reçois quotidiennement une quantité importante de données avec des numéros et noms de rue. Le problème c'est que les données ne sont pas rentrées de la même manière dans chaque cellule... des fois il y a le bis collé au numéro, des fois non, des fois des lettres, des fois des * si il n'y a pas le numéro... Cf fichier joint

J'aurais donc besoin d'éclater la cellule en plusieurs autres cellules avec le numéro si il existe dans la colonne C, le "type de rue" (route, chemin, ect") dans la colonne D et le nom dans la colonne E.

Sachant que le plus important pour moi est le type de rue et son nom. Si je perd l'information "numéro" ce n'est pas grave car l'objectif final est de pouvoir voir si des rues reviennent plus que d'autres

Avez-vous des astuces ? Soit par formule ou VBA, je prends !

Merci de votre aide!!

[Invité]

Bonjour,

Testez ces 3 fonctions à placer dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
54
55
56
 
 
Function ExtraireNumero(ByVal Adresse As String) As String
 
Dim I As Integer
Dim MonNumero As String
 
    ExtraireNumero = ""
    If Len(Adresse) = 0 Then Exit Function
    MonNumero = Split(Trim(Adresse), " ")(0)
 
    For I = 1 To Len(MonNumero)
       Select Case Mid(MonNumero, I, 1)
         Case 0 To 9
              ExtraireNumero = ExtraireNumero & Mid(MonNumero, I, 1)
       End Select
    Next I
 
End Function
 
 
Function ExtraireVoie(ByVal Adresse As String) As String
 
Dim I As Integer
Dim MesVoies As Variant
 
    MesVoies = Array("allée", "allee", "avenue", "chemin", "lotissement", "route", "rue", "voie")
 
    For I = LBound(MesVoies) To UBound(MesVoies)
        If InStr(1, LCase(Adresse), MesVoies(I), vbTextCompare) > 0 Then
           ExtraireVoie = MesVoies(I)
           Exit Function
        End If
    Next I
 
End Function
 
 
 
Function ExtraireNom(ByVal Adresse As String) As String
 
Dim I As Integer, CaractereDebut As Integer
Dim MesVoies As Variant
 
    MesVoies = Array("allée", "allee", "avenue", "chemin", "lotissement", "route", "rue", "voie")
 
    For I = LBound(MesVoies) To UBound(MesVoies)
        CaractereDebut = InStr(1, LCase(Adresse), MesVoies(I), vbTextCompare)
        If CaractereDebut > 0 Then
           ExtraireNom = Trim(Mid(Adresse, CaractereDebut + Len(MesVoies(I))))
           If Right(Trim(ExtraireNom), 1) = "-" Then ExtraireNom = Trim(Mid(Adresse, CaractereDebut + Len(MesVoies(I)), Len(ExtraireNom) - 1))
           Exit Function
        End If
    Next I
 
End Function

Pièce jointe 584094

[cha33]

Super !!

Ca marche parfaitement, merci !!

[cha33]

Bonjour Eric,

J'ai encore un petit soucis avec ce fichier..

Par moment j'ai "ROUTE DE LA VALLEE" mais du coup avec les fonctions, ça n'arrive pas à extraire correctement "ROUTE" puis mettre "DE LA VALLEE". Avez-vous la solution ?

Merci beaucoup!

[Invité]

Bonjour,

Regardez si en changeant simplement l'ordre des voies dans la matrice, cela ne règle pas le problème, comme ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Function ExtraireVoie(ByVal Adresse As String) As String
 
Dim I As Integer
Dim MesVoies As Variant
 
    MesVoies = Array("route", "allée", "allee", "avenue", "chemin", "lotissement", "rue", "voie")
 
    For I = LBound(MesVoies) To UBound(MesVoies)
        If InStr(1, LCase(Adresse), MesVoies(I), vbTextCompare) > 0 Then
           ExtraireVoie = MesVoies(I)
           Exit Function
        End If
    Next I
 
End Function

[cha33]

C'est bon ! Je ne pensais pas que l'ordre avait autant d'importance.

Merci!