format de teléphone sans préfixe

Version imprimable

bonjour
j'utlise une macro pour mettre en forme des numéros de téléphone
je fais d'abord un ménage de ceux ci via les commandes suivantes
Code:

1 2 3 vCell = Application.Clean(Trim(Replace(Replace(Replace(vCell, Chr(9), ""), Chr(10), ""), Chr(160), ""))) vCell = Replace(Replace(Replace(Replace(Replace(vCell, ".", ""), ",", ""), "/", ""), ";", ""), "\", "")
puis le traitement colle un espace tous les 2 digits (avec traitement des téléphones sur 9 et 10 caractères)

comment pourrais je faire pour supprimer les indicatifs style +33, +33(0), 33, etc... le cas échéant

merci de votre aide

david

Bonjour,

C'est un bon candidat pour les expressions régulières:

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
Sub telNb()
    Dim reg
    Dim obj
    Dim txt()
    txt = Array("01.35.08.99.52", _
                "0135089952", _
                "01-35-08-99-52", _
                "01 35 08 99 52", _
                "+331.35.08.99.52", _
                "+33(0)1-35-08-99-52", _
                "+33135089952", _
                "331 35 08 99 52", _
                "01/35/08/99/52", _
                "01\35\08\99\52", _
                "01,35,08,99,52", _
                "331" & VBA.Chr(9) & "35" & VBA.Chr(9) & "08" & VBA.Chr(9) & "99" & VBA.Chr(9) & "52", _
                "331" & VBA.Chr(10) & "35" & VBA.Chr(10) & "08" & VBA.Chr(10) & "99" & VBA.Chr(10) & "52", _
                "331" & VBA.Chr(160) & "35" & VBA.Chr(160) & "08" & VBA.Chr(160) & "99" & VBA.Chr(160) & "52")
 
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    For Each obj In txt
        reg.pattern = "(?:\+?\d{2} *(?:\(0\))? *|0)(\d[\s\-;,\.\\/" & VBA.Chr(160) & "]*(?:\d{2}[\s\-;,\.\\/" & VBA.Chr(160) & "]*){4})"
        obj = reg.Replace(obj, "0$1")
        reg.pattern = "(\d{2})[\s\-;,\.\\/" & VBA.Chr(160) & "]*"
        obj = reg.Replace(obj, "$1 ")
        Debug.Print obj
    Next obj
End Sub

Je n'ai considéré que des indicatifs internationaux à 2 chiffres; à toi de voir ton réel besoin (numéros français?).

bonjour
j'en avais un plus simple sauf pour les numero sans separateur

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
 
Sub telNb()
    Dim reg
    Dim obj
    Dim txt()
    txt = Array("01.35.08.99.52", _
                "0135089952", _
                "01-35-08-99-52", _
                "01 35 08 99 52", _
                "+331.35.08.99.52", _
                "+33(0)1-35-08-99-52", _
                "+33135089952", _
                "331 35 08 99 52", _
                "01/35/08/99/52", _
                "01\35\08\99\52", _
                "01,35,08,99,52", _
                "331" & VBA.Chr(9) & "35" & VBA.Chr(9) & "08" & VBA.Chr(9) & "99" & VBA.Chr(9) & "52", _
                "331" & VBA.Chr(10) & "35" & VBA.Chr(10) & "08" & VBA.Chr(10) & "99" & VBA.Chr(10) & "52", _
                "331" & VBA.Chr(160) & "35" & VBA.Chr(160) & "08" & VBA.Chr(160) & "99" & VBA.Chr(160) & "52")
 
Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    For Each obj In txt
        reg.Pattern = "[^\w]"
        obj = reg.Replace(obj, " ")
         Debug.Print obj
    Next obj
End Sub

Tu ne réponds pas tout à fait à la question (il reste à traiter l'indicatif téléphonique) et tu mets un espace à la place du '+' en début de numéro mais il est vrai que l'on peut simplifier les expressions régulières si l'on suppose que tous les numéros de téléphone ont un format correct (mon expression régulière initiale ne touchera qu'aux numéros ayant un format considéré comme correct).
ça se fait en passant à trois étapes:
Code:

1 2 3 4 5 6 7 8 For Each obj In txt reg.pattern = "\D" obj = reg.Replace(obj, "") 'Suppression de tous les caractères autres que les chiffres reg.pattern = ".*(\d{9})" obj = reg.Replace(obj, "0$1") 'On ne conserve que les neuf derniers chiffres que l'on précède d'un 0 reg.pattern = "(\d{2})" obj = reg.Replace(obj, "$1 ") 'On met un espace après chaque série de deux chiffres Debug.Print obj
NB: [^\w] s'écrit aussi \W (tout comme [^\d] correspond à \D).

a ok je pensait qu'il voulais garder les indicatif 3chiifres/2 chiffres

etant donné que le rex donne le moyen de supprimer tout les autres caracteres il nous reste plus qu'a formater le right(obj,9)

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
Sub telNb()
    Dim reg
    Dim obj
    Dim txt()
    txt = Array("01.35.08.99.52", _
                "0135089952", _
                "01-35-08-99-52", _
                "01 35 08 99 52", _
                "+331.35.08.99.52", _
                "+33(0)1-35-08-99-52", _
                "+33135089952", _
                "331 35 08 99 52", _
                "01/35/08/99/52", _
                "01\35\08\99\52", _
                "01,35,08,99,52", _
                "331" & VBA.Chr(9) & "35" & VBA.Chr(9) & "08" & VBA.Chr(9) & "99" & VBA.Chr(9) & "52", _
                "331" & VBA.Chr(10) & "35" & VBA.Chr(10) & "08" & VBA.Chr(10) & "99" & VBA.Chr(10) & "52", _
                "331" & VBA.Chr(160) & "35" & VBA.Chr(160) & "08" & VBA.Chr(160) & "99" & VBA.Chr(160) & "52")
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    For Each obj In txt
        reg.Pattern = "(\D)"'tout ce qui n'est pas numerique 
        obj = "0" & Format(Right(reg.Replace(obj, ""), 9), "# ## ## ## ##")
         Debug.Print obj
    Next obj
End Sub

01/04/2018, 14h42
Promethee25

C'est effectivement un bon compromis.
03/04/2018, 18h46
munity

Bonjour
Merci à vous deux pour vos propositions
Je teste au plus vite
Sinon pour être plus précis
Il s'agit bien de formater des numeros français mobiles ou fixes
Et il est important d avoir un espace tous les deux digits afin de garder un format texte après traitement

Bonjour à tous

j'ai mis un peu de temps pour répondre à ce post mais comme dit le dicton "tout vient à point à qui sait attendre" :)

merci à vous deux, j'ai réussi à adapter à mon besoin vos codes
voici le résultat

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
 
Sub telNb()
    Dim reg
    Dim obj
    Dim txt()
    Dim i As Long, j As Long, Ligne As Long, Colonne As Long
    Dim Cel As Range, C, tabColonne, Cols, arrSelection, P As Range
 
    On Error Resume Next
        Set P = Application.InputBox("Sélectionnez les colonnes à normaliser :", Type:=8)
        On Error GoTo 0
        Application.DisplayAlerts = True
        If P Is Nothing Then
            MsgBox "Sélection annulée"
            Exit Sub
        End If
 
    txt = Array("01.35.08.99.52", _
                "0135089952", _
                "01-35-08-99-52", _
                "01 35 08 99 52", _
                "+331.35.08.99.52", _
                "+33(0)1-35-08-99-52", _
                "+33135089952", _
                "331 35 08 99 52", _
                "01/35/08/99/52", _
                "01\35\08\99\52", _
                "01,35,08,99,52", _
                "331" & VBA.Chr(9) & "35" & VBA.Chr(9) & "08" & VBA.Chr(9) & "99" & VBA.Chr(9) & "52", _
                "331" & VBA.Chr(10) & "35" & VBA.Chr(10) & "08" & VBA.Chr(10) & "99" & VBA.Chr(10) & "52", _
                "331" & VBA.Chr(160) & "35" & VBA.Chr(160) & "08" & VBA.Chr(160) & "99" & VBA.Chr(160) & "52")
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
 
    arrSelection = P.Address(False, False)
    tabColonne = Split(arrSelection, ",")
 
    For i = 0 To UBound(tabColonne)
        C = GetColumnRange(tabColonne(i))
        Cols = Split(C, ";")
        For j = 0 To UBound(Cols)
            Colonne = CLng(Cols(j))
            Ligne = Cells(Rows.Count, Colonne).End(xlUp).Row
            For Each Cel In Range(Cells(2, Colonne), Cells(Ligne, Colonne))
                reg.Pattern = "(\D)" 'tout ce qui n'est pas numerique
                If Cel.Value <> "" Then
                    Cel.Value = "0" & Format(Right(reg.Replace(Cel, ""), 9), "# ## ## ## ##")
                End If
            Next Cel
        Next
    Next
 
    MsgBox "Traitement Terminé"
 
End Sub

cela tourne correctement

merci encore

david