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