XL 2010 Macro VBA Excel (Doublon,SansAccents,Maj,Min,Nompropre,Espaces superflus)

Virginie17d

XLDnaute Occasionnel
1588208871672.png
 

Pièces jointes

  • MACROS VBA PERSONNEL.xlsm
    60.1 KB · Affichages: 264

Virginie17d

XLDnaute Occasionnel
bon en attendant voila cette version
sj'ai corrigé le rows 2( TOUJOURS) sinon ca prend l'entete de la colonne
et pour les vides a ne pas traiter tout simplement ajouter la condition sur cell empty
dans la boucle for each de la sub
et on doit vider les couleur quelque soit le mode dans rng sinon elle restent ;)
donc
VB:
Option Explicit


Sub PhoneFormat(ZZZ As String, Mode As Long)
    Dim Cellule As Range, LastRow As Long, rng As Range, t$, fx$, area, rng2 As Range
    Set rng = Selection
    If rng.Cells.Count < 1 Then MsgBox "Vous devez sélectionner au moins une cellule  pour appliquer cette macro", vbInformation: Exit Sub
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Select Case Mode
    Case 1: Set rng = rng
    Case 2: Set rng = Cells(2, rng.Column).Resize(LastRow - 1, 1)
    Case 3:
        If rng.Areas.Count = 1 Then
            Set rng = rng.Cells(2, 1).Resize(LastRow - 2, rng.Columns.Count)
        Else
            Set rng2 = rng.Areas(1).Cells(2).Resize(LastRow, 1)
            For Each area In rng.Areas: Set rng2 = Union(rng2, area.Cells(2).Resize(LastRow, 1)): Next
            Set rng = rng2
rng.interior.color=xlnone     
End If
    End Select
    t = "application sur " & rng.Address(0, 0) & " de la fonction"
    If rng.Rows.Count > 1000 Then
        If MsgBox("Ca va prendre du temps sur : " & Format(Selection.Rows.Count, "##,###,##0") & " Cellules" & vbCrLf & "Voulez-vous continuer ?", vbOKCancel) = vbCancel Then Exit Sub
    End If

    Application.StatusBar = t & fx
    ET_Telephone_ou_il_veut rng
    Application.StatusBar = ""
End Sub


Function ET_Telephone_ou_il_veut(ByRef TargetRange As Range)
'format 0033-1-23456789
    Dim Cell As Range
    Dim NotPhoneNumber As Long, IntlPhoneNumber As Long
    Dim PartFRPhone As String
    For Each Cell In TargetRange
        If Cell <> Empty Then
            If Left(Cell.Text, 2) <> "06" Then
                If IsNumeric(Left(Cell.Value, 2)) And Len(Cell.Text) <= 15 Then


                    Select Case Left(Cell.Value, 5)
                    Case "0033-"
                        PartFRPhone = Mid(Cell.Text, 6, Len(Cell.Text))
                        If InStr(PartFRPhone, Chr(45)) = 0 Then
                            If Len(PartFRPhone) = 9 Then
                                Cell.Value = "0033-" & Mid(PartFRPhone, 1, 1) & "-" & Mid(PartFRPhone, 2, 9)
                            Else
                                Cell.Interior.ColorIndex = 6
                                NotPhoneNumber = NotPhoneNumber + 1
                            End If
                        Else
                            If Len(PartFRPhone) <> 10 Then
                                Cell.Interior.ColorIndex = 6
                                NotPhoneNumber = NotPhoneNumber + 1
                            Else
                                'on ne fait rien !
                            End If
                        End If
                    Case "00331"    ' <<<< verrue pour ce format à la noix !
                        Cell.Value = Replace(Cell.Value, "00331", "0033-1-")


                        'Ici Numéro Internationaux ... On ne fait rien pour l'instant !!!
                    Case "00262"    '<<< Mayotte
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "00377"    '<<< Monaco
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "0041-"    '<<< Swiss
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "0039-"    '<<< Italie
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "0049-"    '<<< Allemagne
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "0032-"    '<<< Belgique
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "0034-"    '<<< Espagne
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "00353"    '<<< Irelande
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1
                    Case "0044-"    'Grande Bretagne
                        Cell.Interior.ColorIndex = 8
                        IntlPhoneNumber = IntlPhoneNumber + 1

                    Case Else
                        If Len(Cell) = 9 Then
                            If Left(Cell, 1) <> 6 Then
                                Cell.Value = Format("0033" & Val(Replace(Replace(Cell.Value, " ", ""), ".", "")), "@@@@""-""@""-""@@@@@@@@")
                            Else
                                Cell.Value = Format("0033" & Val(Replace(Replace(Cell.Value, " ", ""), ".", "")), "@@@@""-""@@@@@@@@@")
                            End If
                        Else
                            Cell.Interior.ColorIndex = 6
                            NotPhoneNumber = NotPhoneNumber + 1
                        End If
                    End Select
                Else
                    Cell.Interior.ColorIndex = 6
                    NotPhoneNumber = NotPhoneNumber + 1
                End If

            Else    '<<<<<<<<<  Traitement des "06"
                PartFRPhone = Mid(Cell.Text, 4, Len(Cell.Text))
                If InStr(PartFRPhone, Chr(45)) = 0 Then
                    If Len(PartFRPhone) = 8 Then
                        Cell.Value = "0033-" & "6" & "-" & Mid(PartFRPhone, 1, 9)
                    Else
                        Cell.Interior.ColorIndex = 6
                        NotPhoneNumber = NotPhoneNumber + 1
                    End If
                Else
                    If Len(PartFRPhone) <> 8 Then
                        Cell.Interior.ColorIndex = 6
                        NotPhoneNumber = NotPhoneNumber + 1
                    Else
                        'on ne fait rien !
                    End If
                End If

            End If
        End If

    Next

    If NotPhoneNumber + IntlPhoneNumber > 0 Then
        MsgBox "Traitement fait, mais " & NotPhoneNumber & "  numéro(s) non reconnu(s) comme téléphone (Jaune)" & vbCrLf & _
               "Et " & IntlPhoneNumber & " reconnu(s) comme numéro(s) international/Internationaux (Bleu)", vbExclamation, "Attention Virginie !"
    End If
End Function
voila
les cellules vides ne seront pas traitées
Je viens de tester et les formats ci dessous ne sont pas traités, les autres sont OK
33123456789
01.23.45.67.89
01 23 45 67 89
 

Virginie17d

XLDnaute Occasionnel
les deux forcement l'un ne va pas l'autre ;) :D:D:D
0123455667
123455667
01 23 45 56 67
01.23.45.56.67
1 23 45 56 67
1.23.45.56.67
0033123455667
0033 1 23 45 56 67
0033.1.23.45.56.67
623455667
623455667
06 23 45 56 67
06.23.45.56.67
6 23 45 56 67
6.23.45.56.67
3,3623E+10
0033 6 23 45 56 67
0033.6.23.45.56.67
723455667
723455667
07 23 45 56 67
07.23.45.56.67
7 23 45 56 67
7.23.45.56.67
3,3723E+10
0033 7 23 45 56 67
0033.7.23.45.56.67
fICHIER joint avec les ex
 

Pièces jointes

  • XLD_Virginie17d consolidé et testé 05052020 V1.xlsm
    61.1 KB · Affichages: 9

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir, Vivi, Patrick le fil

Tu nous as mis un exemple de départ qui ne correspond plus du tout à ce que tu montres aujourd'hui ... C'est pas très cool à ce stade...
L'international n'existe plus (Mayotte 00262-298710) ? Les 0033-1-44273461 non plus ?, (etc ...)

Je suis sur une solution, mais bon si ca change pendant qu'on développe ...

@+Thierry
 

Virginie17d

XLDnaute Occasionnel
Bonsoir, Vivi, Patrick le fil

Tu nous as mis un exemple de départ qui ne correspond plus du tout à ce que tu montres aujourd'hui ... C'est pas très cool à ce stade...
L'international n'existe plus (Mayotte 00262-298710) ? Les 0033-1-44273461 non plus ?, (etc ...)

Je suis sur une solution, mais bon si ca change pendant qu'on développe ...

@+Thierry
Bonsoir Thierry,

Je suis désolée, je n'avais pas prit conscience de l'impacte :-( ne me fâche pas stppppppppp
Si c'est trop compliqué laissé, je le ferais en 2 temps en retirant les caractères spéciaux et espaces et ensuite je lancerais la macro des tels
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re Vivi,

Oh je ne me fâche jamais moi, j'ai en charge dans la centaine d'utilisateurs qui, pour certains, mériteraient d'être dans le top 100 des bêtisiers informatiques WorldWide ! Et je ne perds jamais mon sang froid, question d'expérience je suppose. ;)

Tu n'as pas répondu à ma question pour ce qui n'existe plus ?

Et pour la solution paliative que tu proposes, si tu enlèves d'abord les "-", c'est clair que dans l'état l'algo "ET_Telephone_ou_il_veut" ne va plus s'y retrouver...

Donc STP confirmes déjà si nous sommes susceptibles d'avoir à traiter des numéros internationaux ? (il me semble que tu l'avais bien spécifié dans un des posts, mais je ne vais pas relire 19 pages LoL)

PS T'inquiète, c'est souvent le cas des demandes qui parraissent "simples" au début, puis ça devient une "charade à tiroirs" et ça prend une ampleur presque sans fin, avec ces numéros de Tel, on va finir par faire faire de "AI" à VBA !!! Arf LoL... On appelera ça le 'VBAI_Patiti' :eek:

@+Thierry
 

Virginie17d

XLDnaute Occasionnel
Re Vivi,

Oh je ne me fâche jamais moi, j'ai en charge dans la centaine d'utilisateurs qui, pour certains, mériteraient d'être dans le top 100 des bêtisiers informatiques WorldWide ! Et je ne perds jamais mon sang froid, question d'expérience je suppose. ;)

Tu n'as pas répondu à ma question pour ce qui n'existe plus ?

Et pour la solution paliative que tu proposes, si tu enlèves d'abord les "-", c'est clair que dans l'état l'algo "ET_Telephone_ou_il_veut" ne va plus s'y retrouver...

Donc STP confirmes déjà si nous sommes susceptibles d'avoir à traiter des numéros internationaux ? (il me semble que tu l'avais bien spécifié dans un des posts, mais je ne vais pas relire 19 pages LoL)

PS T'inquiète, c'est souvent le cas des demandes qui parraissent "simples" au début, puis ça devient une "charade à tiroirs" et ça prend une ampleur presque sans fin, avec ces numéros de Tel, on va finir par faire faire de "AI" à VBA !!! Arf LoL... On appelera ça le 'VBAI_Patiti' :eek:

@+Thierry
Oui les numéros internationaux sont possible, mais tu as dis ne pas les traiter pour l'instant, c pour ca qu'il n'y en a pas dans mon ex. Il me semble compliqué de reprendre l'ensemble des indicatifs pays. Non ?
 

Discussions similaires

Statistiques des forums

Discussions
311 731
Messages
2 081 993
Membres
101 856
dernier inscrit
Marina40