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

Virginie17d

Virginie17d

XLDnaute Occasionnel
1588208871672.png
 

Pièces jointes

  • MACROS VBA PERSONNEL.xlsm
    60.1 KB · Affichages: 264
Trier par date Trier par votes
Virginie17d

Virginie17d

XLDnaute Occasionnel
patricktoulon à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Virginie17d

Virginie17d

XLDnaute Occasionnel
patricktoulon à dit:
les deux forcement l'un ne va pas l'autre ;) :D:D:D
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif
_Thierry

_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
 
Vote positif 0 Vote négatif
Virginie17d

Virginie17d

XLDnaute Occasionnel
_Thierry à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
_Thierry

_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
 
Vote positif 0 Vote négatif
Virginie17d

Virginie17d

XLDnaute Occasionnel
_Thierry à dit:
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
Cliquez pour agrandir...
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 ?
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
432
crocrocro
C
C
  • Question
macro excel pour filetage
Réponses
1
Affichages
493
Eric KERGRESSE
E
E
  • Question
XL 2021 Identifier de manières fiables les colonnes d'un fichier Excel pour une macro VBA
Réponses
2
Affichages
422
excelentille
E
sebastianbl
  • Résolu(e)
XL 2021 Aide macro / nettoyage fichier
2 3
Réponses
42
Affichages
770
AtTheOne
AtTheOne
R
  • Question
Microsoft 365 VBA Excel PowerPoint
Réponses
5
Affichages
272
Rem6610
R
N
  • Question
XL 2021 VBA traitement d'un fichier
Réponses
4
Affichages
487
sylvanu
sylvanu
C
  • Question
Microsoft 365 Activer et exécuter une macro Excel d'un fichier partagé
Réponses
4
Affichages
272
CHAY150A1
C
OlivGM
  • Question
Autres Une p'tite MACRO VBA
2 3
Réponses
34
Affichages
2 K
TooFatBoy
TooFatBoy
M
  • Résolu(e)
XL 2021 Problème de version sur macro Excel 2010 - 2021
Réponses
12
Affichages
414
mamarus1
M
R
  • Question
Microsoft 365 problème incompatibilité de type 13 sur macro "couper - coller"
Réponses
6
Affichages
322
rh.finances
R

Membres actuellement en ligne

9 membres et 142 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 109
Messages
2 116 299
Membres
112 715
dernier inscrit
Senoussi72