Problème avec fonction VBA pour extraire un numéro de téléphone

Version imprimable

Voir 40 message(s) de cette discussion en une page

1 pièce(s) jointe(s)

Problème avec fonction VBA pour extraire un numéro de téléphone

Bonjour,
dans le cadre du retraitement d'un fichier excel qui m'a été transmis, j'ai créé une fonction qui doit recupérer le contenu d'une cellule et ramener les numéro de téléphone contenu dans celle-ci. Il faut noter qu'un numéro de téléphone comporte 8 chiffres. cependant les colonnes du fichier que je dois traiter ne contienne pas que des numéros de télephone. certaine contiennent des adresses postale, des attestions d'identités etc. En fonction donc de la disparité de toutes ces données j'ai mi en place une fonction qui parcours les caractères d'une cellule pâssée en option et en extrait les numéros de tel. J'ai cependant un souci lorsque les caratères sont numériques, la boucle que j'utilise pour le parcours ne sachève pas et je ne sais pas où se trouve le problème. Merci de bien vouloir jeter un coup d'oeil au code en PJ. merci

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Public Function MemeType(chaine As String, i As Long) As Boolean
    If IsNumeric(Mid(chaine, i, 1)) = IsNumeric(Mid(chaine, i - 1, 1)) Then
        MemeType = True
        Else
        MemeType = False
    End If
End Function
 
 
Public Function NumTel(Col As Range) As String
Dim chaine As String
Dim LenChaine As Long
Dim Pos1 As Long
Dim Pos2 As Long
Dim i As Long
Dim j As Long
Dim strlettre As String
Dim strnum As String
Dim varnum As Boolean
Dim veriftype As Boolean
Dim start As Long
chaine = Replace(Replace(Replace(Replace(Replace(Replace(Trim(Col), " ", ""), ".", ""), "/", ""), "*", ""), "+", ""), "-", "")
'MsgBox "la chaine: " & chaine
	If Len(chaine) >= 8 Then '1
		'MsgBox "Longueur Chaine: " & Len(chaine)
		strlettre = ""
		Pos1 = 1
		'MsgBox "Le Premier caractère de la chaine: " & Mid(chaine, Pos1, 1)
		'MsgBox "Est numérique premier caractere=" & IsNumeric(Mid(chaine, 1, 1))
	'For i = 2 To Len(chaine)
		i = 2
		Do While i < Len(chaine)
			'MsgBox "Boucle numéro " & i - 1
			'MsgBox "Caractere " & i & " = " & Mid(chaine, i, 1)
			'MsgBox "Est numérique " & i & " = " & IsNumeric(Mid(chaine, i, 1))
			'MsgBox "Est numérique " & i - 1 & " = " & IsNumeric(Mid(chaine, i - 1, 1))
			'MsgBox "Verif Type=" & MemeType(chaine, i)
			veriftype = MemeType(chaine, i)
				If veriftype = False Then '2
					Pos2 = i - 1
					'MsgBox "POsition de fin de chaine =" & Pos2
					'MsgBox "La chaine à considerer est-elle numérique ? = " & IsNumeric(Mid(chaine, Pos2, 1))
						If IsNumeric(Mid(chaine, Pos2, 1)) Then '3
							'MsgBox "Nombre de caratère = " & Pos2 - Pos1 + 1
							'MsgBox "Verif Modulo =" & (Pos2 - Pos1 + 1) Mod 8
							'MsgBox "Condition copie chiffre" & ((Pos2 - Pos1 + 1) Mod 8 = 0 And (strlettre = "" Or LCase(strlettre) = "cel" Or LCase(strlettre) = "tel"))
							If ((Pos2 - Pos1 + 1) Mod 8 = 0 And (strlettre = "" Or LCase(strlettre) = "cel" Or LCase(strlettre) = "tel")) Then '4
								start = Pos1
								For j = 1 To (Pos2 - Pos1 + 1) / 8
									'MsgBox "Numéro de tel = " & Mid(chaine, start, 8)
									NumTel = NumTel & " - " & Mid(chaine, start, 8)
									start = start + 8
								Next j
								strlettre = ""
								Pos1 = Pos2 + 1
								Pos2 = ""
							End If '4
						Else '3
							'MsgBox "La chaine = " & Mid(chaine, Pos1, Pos2 - Pos1 + 1)
							strlettre = Mid(chaine, Pos1, Pos2 - Pos1 + 1)
							Pos1 = Pos2 + 1
							'MsgBox "Nouvelle position P1= " & Pos1
							Pos2 = ""
						End If '3
				End If '2
	'Next i
		i = i + 1
		Loop
	Else '1
		NumTel = ""
	End If '1
 
End Function

10/11/2014, 12h40
patricktoulon

re

pourrait tu donnée un exemple de fichier excel plutôt avec des données bidon bien sur mais du même format que celle que tu traite????
10/11/2014, 13h46
Kanigui

1 pièce(s) jointe(s)

Comme demandé
Pièce jointe 161058
10/11/2014, 16h53
patricktoulon

re

re

le principe d'automatisation de procédure en vba est du au fait qu'une action peut se répéter plusieurs fois de la même façon
a ce que j'ai vu de ton fichier sur moins de 20 lignes il y a 3 sorte
il faut savoir que excel ou même vba ne devine pas

maintenant si on en reste a ce que démontre ton fichier et que l'on y rajoute pas de variante tu pourrais tout simplement faire une boucle sur les cellules de la colonne"B" et utiliser la fonction "like" avec une variable de type string du genre "tel:" ou cel:"
j'ai tout dis !!!!

fait une recherche sur cette fonction
si tu y arrive pas je te ferais un exemple

même avec la fonction like il y a trop de paramètres en cause
je 'ai fait un exemplaire avec la fonction" instr" sur les mêmes variables
dans cette boucle il y a 4 test
1 test sur la presence de "tel:"
2 test de la presence de "cel:"
3 test de la presence "-" sil "tel:" et "cel:" sont absent
4 test de la presence de "-" si "tel:"ou "cel:"est present

5 en sortie et remplissage du tableau en mémoire teste de "cel: ou "tel:" pour placer le numéro dans la bonne colonne (fixe/portable)

espérons qu'il n'y ai pas encore un paramètre qui vienne foutre le boxon dans tes prochaines grille de donnée
met ca dans un module standard et lance test dans le fichier que tu m'a envoyé
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Option Base 1 Sub test() Dim tabloA, tablotel tabloA = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row) ReDim tablotel(UBound(tabloA), 2) For i = 1 To UBound(tabloA) If InStr(LCase(tabloA(i, 1)), "tel:") > 0 Or InStr(LCase(tabloA(i, 1)), "cel:") > 0 Then numtel = Split(tabloA(i, 1), ":")(1) If UBound(Split(numtel, "-")) > 0 Then tablotel(i, 1) = Split(numtel, "-")(0) tablotel(i, 2) = Split(numtel, "-")(1) Else: col = IIf(InStr(LCase(tabloA(i, 1)), "tel:") > 0, 1, 2) tablotel(i, col) = numtel End If ElseIf InStr(LCase(tabloA(i, 1)), "tel:") = 0 Or InStr(LCase(tabloA(i, 1)), "cel:") = 0 Then If UBound(Split(tabloA(i, 1), "-")) > 0 Then tablotel(i, 1) = Split(tabloA(i, 1), "-")(1) End If End If Next i Cells(2, 4).Resize(UBound(tablotel), 2) = tablotel End Sub
maintenant pour l'instant j'ai mal a la tete :ptdr:

10/11/2014, 18h44
Kanigui

Au fait l'enjeu de ma fonction va au delà de rechercher les mots clé "Cel" ou "Tel" dans les cellules de la colonne B.
Considérons que le fichier excel représente le résultat d'une requête établissant la liste des clients ayant effectué un
achat sur au sein d'une entreprise et que la colonne B doit contenir les contacts téléphoniques des clients. Cependant, le champ de saisie n'ayant pas été soumis à restriction (masque de saisie) les utilisateurs ont renseigné les données selon leur "inspiration" allant jusqu'à renseigner des num de pièce d'identité ou des adresses postales en lieu et place des numéros de téléphone. Lorsque certains séparent les chiffres avec des espaces d'autres utilisent des tirets, certains saisissent directement le numéro alors que d'autres les préfixent de "tel" ou "cel".
Dans le souci donc de récupérer le maximum de numéro de tel "conformes" j'ai créé cette fonction.
Sachant donc que les numéros de tel dans le pays sont sur 8 positions, la méthode trouvée est donc la suivante:
1 récupérer le contenu de la cellule
2 supprimer tous les caractères spéciaux (espace, etc,)
3 parcourir les caractères restants et identifier tous les groupes de 8 chiffres consécutifs (donc susceptibles de représenter un numéro de téléphone valide)
4 pour un groupe de 8 chiffres trouvé on vérifie les cas suivant avant de le confirmer:
. soit il ne comporte aucun préfixe,
. soit il comporte un préfix qui est tel ou cel (critère défini après avoir parcouru les enregistrements du fichier)
C'est donc ce process que j'ai implémenté en VBA, seulement le constat est que lorsque la fonction passe sur le caractère numérique
la boucle de traitement défini ne se poursuit plus. et je ne sait pas pourquoi?
Le programme se déroule plutôt bien quand les caractères sont alphabétiques mais une fois qu'il tombe sur un numérique il sort de la boucle.
10/11/2014, 18h55
SfJ5Rpw8

Je comprends pas le but de ta fonction : MemeType ... qui me semble-t-il renvoi faux lorsque 2 caractères numérique se "suivent"
10/11/2014, 19h11
Marc-L

Bonjour.

Citation:

Envoyé par Kanigui

lorsque la fonction passe sur le caractère numérique la boucle de traitement défini ne se poursuit plus. et je ne sait pas pourquoi?

Pour trouver l'erreur de conception c'est simple : exécuter le code en mode pas à pas via la touche F8
tout en contrôlant le contenu de la fenêtre des Variables locales …
10/11/2014, 19h14
patricktoulon

re

re
je vois que tu n'a pas compris mes remarques
supposons alors que le client marque dans la case adresse

3rue de paris 75 22 0 05 23 15 45 comme c'est déjà arrivé dans l'exemple que tu ma donné
3rue de paris 05 23 15 45 75 22 0 comme c'est déjà arrivé dans l'exemple que tu ma donné

on prend quoi? pour le téléphone

c'est ce que j'ai essayé de te faire comprendre en te disant que excel ne devine pas
je craint fort que ca ne soit pas sur le fichier excel qu'il fasse faire un travail
mais plutôt sur la page du site pour que les utilisateur ne puissent pas taper autre chose que ce qui leur est demandé
un pansement sur une jambe de bois ca n'a jamais résolu le problème

moi ce que j'en dis hein!!

Bonjour.

Il ne faut pas supprimer les caractères non-numériques. Au contraire, il faut analyser le texte un caractère à la fois et utiliser les caractères non-numériques comme indices indiquant le début et la fin du numéro de téléphone.

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
54
55
56
57
Sub tt()
    Dim r As Range
 
    Set f = ThisWorkbook.Worksheets("Feuil1")
 
    dern = f.Cells(Rows.Count, 1).End(xlUp).Row
 
    For ligne = 2 To dern
 
        Set r = f.Cells(ligne, 2)
 
        resultat = NumTelGB(r)
 
        t = Split(resultat, "?")
 
        For i = 0 To UBound(t)
            f.Cells(ligne, i + 4) = t(i)
        Next
 
    Next
 
End Sub
 
Function NumTelGB(col As Range) As String
 
    NumTelGB = ""
    For i = 1 To Len(col)
 
        a = Mid(col, i, 1)
 
        If a = " " Then
 
        ElseIf a = "." Then
 
        ElseIf IsNumeric(a) Then
 
            numero = numero & a
 
        Else
 
            If Len(numero) = 8 Then
                NumTelGB = NumTelGB & numero & "?"
            End If
 
            numero = ""
        End If
 
    Next
 
    If Len(numero) = 8 Then
        NumTelGB = NumTelGB & numero & "?"
    End If
 
    If NumTelGB <> "" Then
     NumTelGB = Mid(NumTelGB, 1, Len(NumTelGB) - 1)
    End If
End Function

11/11/2014, 00h12
patricktoulon

re

salut Docmarti

Code:

Dim r As Range

Code:

resultat = NumTelGB(r)

Code:

Function NumTelGB(col As Range) As String

j'ai peur de ne pas comprendre
11/11/2014, 01h11
Kanigui

Citation:

Envoyé par bbil

Je comprends pas le but de ta fonction : MemeType ... qui me semble-t-il renvoi faux lorsque 2 caractères numérique se "suivent"

Cette fonction compare 2 caractères consecutifs et determine s' ils sont de même type (alphabétique ou numérique). L'intérêt est de pouvoir identifier dans la cellule toutes les suites de caracteres alphabétiques et numériques. Si j'identifie une suite de caracteres numériques je compte le nombre de chiffres qu'elle comporte. Si je trouve 8,16,24 caractères (nbre caractère modulo 8=0) alirs je suppose que c un numéro de téléphone. Puis je vais un peu plus loin ds le contrôle en vérifiant si oui ou non j'ai un "préfixe alphabétique en mémoire" si je n'ai pas de préfixe en mémoire ou que le préfixe ven lemoire est "tel"ou "cel" je valide la suite numérique comme numéro de téléphone.
Nb: lorsque je rencontre une suite de caractère alphabétique je la sauvegarde ds strlettres et je vide cette variable une fois que je rencontre une suite numérique et que je fini de la traiter
11/11/2014, 01h22
patricktoulon

re

a tu au moins essayé celui que je t'ai donné????

il te donne 2 numero de tel si il y en a 2
1 si il en a 1
qu'il y ai "tel" ou "cel" ou juste un tiret
je vois pas ce qui te faut de plus
11/11/2014, 01h23
Kanigui

Citation:

Envoyé par patricktoulon

re
je vois que tu n'a pas compris mes remarques
supposons alors que le client marque dans la case adresse

3rue de paris 75 22 0 05 23 15 45 comme c'est déjà arrivé dans l'exemple que tu ma donné
3rue de paris 05 23 15 45 75 22 0 comme c'est déjà arrivé dans l'exemple que tu ma donné

on prend quoi? pour le téléphone

c'est ce que j'ai essayé de te faire comprendre en te disant que excel ne devine pas
je craint fort que ca ne soit pas sur le fichier excel qu'il fasse faire un travail
mais plutôt sur la page du site pour que les utilisateur ne puissent pas taper autre chose que ce qui leur est demandé
un pansement sur une jambe de bois ca n'a jamais résolu le problème

moi ce que j'en dis hein!!

Oui oui je n'avais pas compris. Pour le cas énoncé, Comme je l'ai dit les numeros de téléphone dans mon pays sont sur 8 positions. Dans l'exemple défini ci dessus on prendra le premier chiffre. On a donc 1 caratere numerique. 1 modulo 8 on a 1 qui est différent de zero donc ce n'est pas un numéro de téléphone. J'enregistre "ruedeparis" ds ma variable alphabétique tampon. Je considère ensuite l'autre série numérique. Je comptabilise 13 chiffres. 13 modulo 8 étant différent de 0. Je deduis que ce n'est pasun num de téléphone dc la fonction ramènera une chaîne vide soit "".
11/11/2014, 02h10
Docmarti

Salut Patrick.

Dans le langage VBA de Excel, le membre par défaut de l'objet Range est sa propriété Value. Si tu veux voir tous les autres membres de l'objet Range, appuie sur la touche F2 (ou va dans Affichage/Explorateur d'objet)

Le fait d'avoir un membre par défaut permet au programmeur VBA, si ce qui l'intéresse est la valeur du membre par défaut, d'omettre le nom du membre. Ainsi on peut écrire

Code:

Range (" A1 ") = 1234

au lieu de

Code:

Range (" A1 ").Value = 1234

Si je voulais recevoir dans la Fonction NumTelGB() uniquement la valeur de la propriété Value, je pourrais écrire

Code:

resultat = NumTelGB(r.Value)

Mais j'ai choisi d'écrire

Code:

resultat = NumTelGB(r)

pour envoyer l'objet Range avec tous ses membres, parce que j'aime bien avoir accès à la propriété Address du Range pour pouvoir visualiser immédiatement le résultat obtenu dans la cellule.
11/11/2014, 02h35
Kanigui

Citation:

Envoyé par patricktoulon

a tu au moins essayé celui que je t'ai donné????

il te donne 2 numero de tel si il y en a 2
1 si il en a 1
qu'il y ai "tel" ou "cel" ou juste un tiret
je vois pas ce qui te faut de plus

Oui j'ai testé mais ce n'est pas très exactement ce que je cherchais à faire
11/11/2014, 06h32
Marc-L

Bonjour.

Citation:

Envoyé par Docmarti

Dans le langage VBA de Excel, le membre par défaut de l'objet Range est sa propriété Value.

Méfie-toi car à d'exceptionnelles occasions VBA peut choisir la propriété Text au lieu de Value;
j'en connais qui s'en mordent encore les doigts de ne pas avoir précisé la propriété Value dans leur code,
j'ai bien ri de voir leurs têtes après avoir réglé leur bug en quelques secondes alors qu'ils cherchaient depuis longtemps !
11/11/2014, 09h54
patricktoulon

re

Citation:

Envoyé par Kanigui

Oui j'ai testé mais ce n'est pas très exactement ce que je cherchais à faire

a oui c'et quoi que tu cherche faire parce que la je te comprend plus ??????

en post #1 tu disais devoir parcourir les cellule et en extraire les numéros de tel

c'est exactement ce que la macro fait maintenant si c'est le rapatriement des num tel qui ne sont pas placé au bon endroit libre a toi de changer la destination de tablotel

si c'est pas ca alors je suis dans le flou. te serait tu mal exprimé ou aurais je eu une soudaine et fulgurante crise d'amnésie????

et puis si tu y tiens
tu peut ajouter dans le tablotel le test sur la presence des 8 caractères numériques
moi je dis ca je dis rien hein ....

un autre détail
il me semble avoir lu dans le post que ces données était le résultat d'une requête

il se trouve que parfois le résultat ne respecte pas le shema des positions des données sur la page du site
en fait plutôt que envoyer le tout en vrac sur une feuille excel comme ca et faire un tri de fou
tu pourrais simplement analyser la page avant tu serais surpris du résultat

pour ce genre de travaux il y a des personne qui pourront t'aiguiller plus que correctement

pour me faire une idée ne pourrais tu pas faire une capture d'écran de cette page en modifiant les données confidentielle juste pour voir
11/11/2014, 15h42
Kanigui

1 pièce(s) jointe(s)

@ patricktoulon
Pour le fichier exemple que j'ai transmis précédemment la fonction récupère effectivement les numéros de téléphone.
Mais les données à traiter sont en effet plus disparates que ça.
Je joins donc la pièce jointe précédente avec dans la feuille 2 à quoi ressemble les données de la colonne contact du fichier.
(J'ai seulement à ce niveau mis tous les caractères numériques à 9).
Pour ce qui est de l'interface je n'y ai moi même pas accès. J'ai également demandé que la saisie pour les autres cas puisse
être soumise à certaines règles de validation. Mais en attendant il m'a été demandé de récupérer à partir de ce fichier le maximum de numéro de
téléphone.
MerciPièce jointe 161190
11/11/2014, 16h38
patricktoulon

1 pièce(s) jointe(s)

re

OK
alors par rapport a cette capture d'écran de ton nouveau fichier
donne moi simplement les numéros de ligne qui pour toi sont bonnes
on ira plus vite comme ca

une petite remarque cependant

en ligne 38 il y a bien une série de 8 chiffre séparé par des "/" :cette série est elle bonne

2 remarque cette ligne 38 c'a m'étonnerais beaucoup que ca soit tapé par un utilisateur et de cette façon en plus

donc conclusion si la requête t'envoie un fichier exel comme ca et que si on considère que les utilisateur entre n'importe quoi n'importe ou a mon avis il manques des colonnes dans ton fichier exel

et donc des donnée présente dans le site même mal placé ,mais plus du tout présent dans le fichier excel

enfin je veux bien t'aider mais si tu a compris ce que je viens de dire tu en conclura toi même de la marche a suivre

Pièce jointe 161192

Voir 40 message(s) de cette discussion en une page