Discussion :

[Kanigui]

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 :

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
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

[patricktoulon]

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????

[Kanigui]

Comme demandé
Fichier exemple.xlsx

[patricktoulon]

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

[patricktoulon]

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 :

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
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

[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.

[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"

[Marc-L]

Bonjour.

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 …