[XL-2007] Fonction extraction d'une chaine hors d'un string

[freddyev]

Bonjour,
J'ai une feuille excel avec 60000 adresses.
Problème, la rue, le code postal, la localité et éventuellement une communication sont collés dans une chaîne de caractères.
le code postal est l'élément qui me permettrait dans 99% des cas de séparer l'adresse du code postal et de la localité (les CP belge font 4 chiffres et le 1er nombre>999 est presque à coup sûr un code postal).
Je veux créer une fonction qui me permettrait de décomposer la chaîne.
Le bout de code ci-dessous marche parfaitement, il y a juste que je ne parviens pas à afficher la variable "cploc"

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Function repereCP()
Dim chaine As String
chaine = ActiveCell.Offset(0, 1)
For i = 1 To Len(chaine) - 4
   If Val(Mid(chaine, i, 4)) > 999 Then
      cploc = Mid(chaine, i, 100)
      ActiveCell.Value = cploc
      Exit For
   End If
Next
End Function

la ligne "ActiveCell.Value = cploc" m'affiche "0"
si je fais msgbox cploc le contenu est bien ce que je veux récupérer mais je sèche sur la façon de l'afficher.
Pouvez vous me donner un coup de pouce ?

[kiki29]

Salut, la meilleure solution serait via une expression régulière , voir http://cafeine.developpez.com/access/tutoriel/regexp/, cependant dans ton cas lire d'abord http://silkyroad.developpez.com/vba/fonctions/
car ta "fonction" ne peut pas tourner correctement

De façon basique sous forme de fonction personnalisée

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Option Explicit
 
Function Extraction(sString As String) As String
Dim sChaine As String
Dim i As Long
 
        sChaine = Trim$(sString)
        For i = 1 To Len(sChaine)
            If Val(Mid$(sChaine, i, 4)) > 999 Then
                sChaine = Mid$(sChaine, i, Len(sChaine) - i + 1)
                Exit For
            End If
        Next i
        Extraction = sChaine
End Function

[freddyev]

Merci pour ta réponse mais je pensais qu'il ne me fallait pas grd chose pour faire fonctionner cette fonction...

Je crois que je vais opter pour un traitement sous access, je suis plus à l'aise avec cet environnement pour ce qui est de la programmation.

En fait j'ai juste besoin d'une moulinette pour décortiquer mes chaines de caractères et dégrossir un max l'inévitable travail de finalisation qui devra quand même se faire de façon ± manuelle.

[gFZT82]

Bonsoir,

Le principe de ton code semble correct.
A tester :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function repereCP(chaine As String) As Integer
Dim cploc As Integer
For i = 1 To Len(chaine) - 4
   If Val(Mid(chaine, i, 4)) > 999 Then
      cploc = Val(Mid(chaine, i, 100))
      MsgBox "Adresse : " & Left(chaine, i - 1)
      MsgBox "Code Postal : " & cploc
      MsgBox "Ville : " & Right(chaine, Len(chaine) - i - 4)
      repereCP = cploc
      Exit For
   End If
Next
End Function
 
Sub Test()
Dim chaine As String
    chaine = ActiveCell.Offset(0, 1)
    ActiveCell.Value = repereCP(chaine)
End Sub

Cordialement.