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