Séparer des adresses (Rue et N°) en 2 cellules

[Justine89]

Bonjour,

J'ai un fichier client que je dois séparer pour l'insérer dans notre base de données. Et j'ai un soucis avec les adresses.
Voilà un exemple de ce que je peux avoir :
17A, Avenue de la Gare
Avenue de la Gare 17A

et je voudrais le mettre dans 2 cellules sous cette forme
Avenue de la Gare (1e cellule) 17A (2e cellule)
Il faudrait donc que j'ai mes chiffres toujours à la fin de la cellule je pense... Mais vu le nombre de client que j'ai, si je le fais à la main, j'en ai pour 30 ans...

Mais je ne trouve pas de fonction qui le permet. Et je ne connais pas grand chose au macro (si cela devait servir à quelque chose...)

J'ai trouvé sur internet un fichier compliqué qui donne un résultat plus ou moins correcte (vous le trouvez ici)

Edit : Je joins mon fichier avec le résultat idéal en Colone B et C

 

[david84]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour,
pour la rue :

=STXT(A1;CHERCHE(",";A1)+2;99)

pour le n° :

=GAUCHE(A1;CHERCHE(",";A1)-1)

A+

 

[Abel]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour Justine89,

Il nous faudrait un exemple pour y voir plus clair (sans données confidentielles, bien sûr) dans les formats de tes données de départ.

Il faudra qu'on gère le 14, avenue de la 1ère Armée (par exemple).

Abel.

Edit : bonjour David84

 

[Justine89]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour,

merci à tous les deux. Voici un exemple de mon fichier. Je vous ai laissé que les rues en nombre réduite, mais il y a les principaux formats que je peux avoir. Le voici

J'ai donc le numéro de la rue n'importe ou, des fois devant suivit d'une virgule, ou collé à la rue, des fois derrières avec virgule ou pas... Le bordel total...

Merci pour votre aide.

 

[Misange]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour

Tu sais que tu peux joindre un fichier directement sur le forum ?
Ca évite de devoir poireauter 1minute pour le faire sur le lien que tu as indiqué et surtout, ce fichier sera pérenne ici alors que sur les autres sites ils finissent pas disparaitre ce qui rend incompréhensible bien souvent les quesitons et réponses.


GRRR poireauter 1 minute DEVANT le compteur qui défile tout ça pour que le fichier soit endommagé et ne s'ouvre pas chez moi...

va sur mode avancé, clique sur le trombone et joins un bon fichier

 

[Justine89]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Ah je ne savais pas... désolée alors voici mon fichier

 

[Abel]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Re,

Foooouuuiaaaaa !

Exemples lignes 29 et 32, que doit-on sortir comme info ?

Abel.

 

[Misange]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Boudiou ! tu n'es pas au bout de tes peines. En fait je voulais essayer la nouvelle fonctionnalité flashfill d'excel 2013 qui est supposée savoir faire ce genre de trucs. Ben sur un truc aussi peu logique que celui proposé, sans surprise, le résultat n'est pas plus utilisables que le départ. J'avais déjà essayé sur plusieurs trucs et si dans les démos ça parait génial, comme je le pressentais, dans la vraie vie... bof.

Pour ma part je ne vois pas trop comment automatiser cette recherche. Désolée

 

[david84]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Re

un beau bordel...merci d'inscrire manuellement dans ton fichier les résultats attendus dans les colonnes B et C histoire de comprendre un peu mieux.
A+

 

[Justine89]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Oui c'est un bordel total... Pour ca que je demande ici. Car pour l'instant je me débrouille avec le fichier cité dans mon premier message, qui s'en sort pas trop trop mal.

Je pense qu'il faudrait faire qqchose pour que les chiffres aillent à la fin et qu'ensuite ca sépare en deux... Comment y arriver je n'en ai aucune idée!

Le système où ses données sont mises, n'est pas modifiable, sinon j'aurais demandé de créer directement 2 cases séparées, mais on peut pas.

Je vous ai mis dans le fichier l'idéal. Après Si je dois reprendre à la main les adresses étranges comme ligne 29 c'est pas trop grave. Ce n'est pas la majorité de mon fichier.

Voila, merci pour votre aide... et bon courage

P.s Je ne m'attends pas a un résultat parfait, mais quelques choses d'acceptable

 

[david84]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Re

P.s Je ne m'attends pas a un résultat parfait, mais quelques choses d'acceptable

Une version Béta via l'utilisation d'expressions rationnelles, imparfaite, incomplète et brute de décoffrage.
Le problème est que je n'ai pas le temps d'en faire plus, mais si cela peut déjà t'aider :
Une fonction personnalisée pour la voie :

Function Voie(chaine As String) As String
Dim oRegExp As Object, Matches As Object
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
    .Global = True
    .ignorecase = True
    chaine = Replace(chaine, ",", " ")
    
    chaine = Application.WorksheetFunction.Trim(chaine)
    .Pattern = "(.+[a-z])(\.)(\d.*)"
    If .test(chaine) Then
        Set Matches = .Execute(chaine)
        chaine = .Replace(chaine, "$1 $3")
    End If
   
    .Pattern = "(^(?:No |Appt )?\d+\S*)\s(.*)"
    If .test(chaine) Then
        Set Matches = .Execute(chaine)
        Voie = .Replace(chaine, "$2")
        Exit Function
    End If
    .Pattern = "(\D+)(\d.*)"
    If .test(chaine) Then
        Set Matches = .Execute(chaine)
        Voie = .Replace(chaine, "$1")
        Exit Function
    End If
   Voie = chaine
End With
End Function

Un autre fonction personnalisée pour le numéro :

Function Num(chaine As String) As String
Dim oRegExp As Object, Matches As Object
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
    .Global = True
    .ignorecase = True
    chaine = Replace(chaine, ",", " ")
    
    chaine = Application.WorksheetFunction.Trim(chaine)
    .Pattern = "(.+[a-z])(\.)(\d.*)"
    If .test(chaine) Then
        Set Matches = .Execute(chaine)
        chaine = .Replace(chaine, "$1 $3")
    End If
   
    .Pattern = "(^(?:No |Appt )?\d+\S*)\s(.*)"
    If .test(chaine) Then
        Set Matches = .Execute(chaine)
        Num = .Replace(chaine, "$1")
        Exit Function
    End If
    .Pattern = "(\D+)(\d.*)"
    If .test(chaine) Then
        Set Matches = .Execute(chaine)
        Num = .Replace(chaine, "$2")
        Exit Function
    End If
   Num = vbNullString
End With
End Function

Bonne continuation
A+

 

[Justine89]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour,

merci beaucoup. Le résultat a vraiment l'air bien

par contre.... comment je fais concrètement pour faire ça ? c'est bien une macro ? j'en ai jamais fait... Est-ce que tu peux me guider ?

Merci !

 

[david84]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour,

merci beaucoup. Le résultat a vraiment l'air bien

par contre.... comment je fais concrètement pour faire ça ? c'est bien une macro ? j'en ai jamais fait... Est-ce que tu peux me guider ?

Merci !

Ce sont des fonctions personnalisées à copier dans un module classique et à utiliser comme une fonction classique d'Excel.
Regarde dans le fichier : tu fais ALT+F11 pour ouvrir l'éditeur VBE.
Dans l'explorateur de projets (fenêtre de gauche) tu trouveras un module nommé module1 : double clic sur ce module et tu as le code des 2 fonctions.

Ceci dit, je me demande tout de même si une Sub ne serait pas plus pratique pour ton cas car tu aurais alors le résultat en "dur" dans la feuille et non le nom de la fonction.
A+

 

[Gen Rose]

Re : Séparer des adresses (Rue et N°) en 2 cellules

OK, j'ai dit une bêtise

Je te renvoie le fichier; tu verra en B1 et C1 il y a une formule; fait juste la descendre et elle traite automatiquement ta première colonne.

Le travail de David fonctionne à merveille.

 

[job75]

Re : Séparer des adresses (Rue et N°) en 2 cellules

Bonjour à tous,

J'y vais de ma solution :

Sub Adresses()
Dim tablo, ad$(), i&, t$, s, ub%, j%
tablo = Range("A2:A3", Cells(Rows.Count, 1).End(xlUp))
ReDim ad(1 To UBound(tablo), 1 To 2)
For i = 1 To UBound(tablo)
  t = Replace(tablo(i, 1), ".", " ") 'point remplacé
  t = Replace(t, ",", "") 'suppression virgule
  t = Application.Trim(t) 'SUPPRESPACE
  s = Split(t)
  ub = UBound(s)
  If ub >= 0 Then
    For j = 0 To ub
      If s(j) Like "*#*" Then
        ad(i, 2) = s(j)
        If j Then If LCase(s(j - 1)) Like "ap*t" Or Len(s(j - 1)) < 3 _
          Then ad(i, 2) = s(j - 1) & " " & s(j) 'appartement ou N°
        If j < ub Then If Len(s(j + 1)) = 1 Or IsNumeric(s(j + 1)) _
          Then ad(i, 2) = ad(i, 2) & " " & s(j + 1) 'caractères isolés
        ad(i, 1) = Application.Trim(Replace(t, ad(i, 2), "", , 1))
        Exit For
      End If
      ad(i, 1) = t
    Next
  End If
Next
[B2:C2].Resize(UBound(ad)) = ad
Range("B" & UBound(ad) + 2 & ":C" & Rows.Count).ClearContents
End Sub

Fichier joint.

A+