XL 2010 Macro VBA Excel (Doublon,SansAccents,Maj,Min,Nompropre,Espaces superflus)
- Initiateur de la discussion Virginie17d
- Date de début
-
- Mots-clés
- espaces maj min nompropre sansaccents
Solution
patricktoulon
XLDnaute Barbatruc
ok vu #322/323 c'est pas bon du tout on ne fait de boucle sur de string c'est pas possible
for "M" to "O" ---> pas bon
c'est dans le code des cellule qu'il fait toucher
for "M" to "O" ---> pas bon
c'est dans le code des cellule qu'il fait toucher
Virginie17d
XLDnaute Occasionnel
Comment a mon niveau de connaissance je peux savoir où ajouter une boucle ? Il va peut être que je regarde les tutos de départ sur VBA que je trouve la logique de ce que je fais
patricktoulon
XLDnaute Barbatruc
je vais regarder
le b a ba
pour les boucles"for" c'est toujour des numerique pas des lettre entre guillemet sinon c'et du string
for i= 1 to 10--> boucle de 1à 10
le b a ba
pour les boucles"for" c'est toujour des numerique pas des lettre entre guillemet sinon c'et du string
for i= 1 to 10--> boucle de 1à 10
Virginie17d
XLDnaute Occasionnel
patricktoulon
XLDnaute Barbatruc
donc si j'ai bien compris ta demande tu voudrais que ça agisse uniquement sur les cellules remplies
et donc toutes les cellules vides doivent rester blanches
c'est bien ça ?
et donc toutes les cellules vides doivent rester blanches
c'est bien ça ?
patricktoulon
XLDnaute Barbatruc
tu n'a pas répondu a ma question????
et ta macro multi colonnes ne fonctionne pas
et ta macro multi colonnes ne fonctionne pas
patricktoulon
XLDnaute Barbatruc
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
voila
les cellules vides ne seront pas traitées
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 Functionles cellules vides ne seront pas traitées
Virginie17d
XLDnaute Occasionnel
Oui c’est ça blanche pardon
patricktoulon
XLDnaute Barbatruc
ben voila c'est fait et comme je l'ai dit j'ai corrigé le rows2
Virginie17d
XLDnaute Occasionnel
Ok merci désolé je fais manger la petite je test et je te dis cela.
Tu as ajouté la règle pour le format tel 01.44.55.33.55 avec les points ?
Tu as ajouté la règle pour le format tel 01.44.55.33.55 avec les points ?
patricktoulon
XLDnaute Barbatruc
non je pense que ca c'est dans la partie "@@@...."
patricktoulon
XLDnaute Barbatruc
a ouais c'est coton maintenant d'intégrer cela dans ce principe
patricktoulon
XLDnaute Barbatruc
ok tu met le replace juste la
If Left(Cell.Text, 2) <> "06" Then
Cell = Replace(Cell, ".", "")
'...
'....
'.....
maintenant on est bon
re edit non c'est pas bon mince c'est tout le principe qui est a revoir difficile de l'intégrer dans le selectcase left y a trop de possibilités
pourais je avoir une liste tel que les numeros arrive a l'original
If Left(Cell.Text, 2) <> "06" Then
Cell = Replace(Cell, ".", "")
'...
'....
'.....
maintenant on est bon
re edit non c'est pas bon mince c'est tout le principe qui est a revoir difficile de l'intégrer dans le selectcase left y a trop de possibilités
pourais je avoir une liste tel que les numeros arrive a l'original
Dernière édition:
Virginie17d
XLDnaute Occasionnel
Difficile de me mettre dans la tete de mes clients très tordu dès qu'on leur demande de faire quelques dont une lignes d'exemple est noté.
De tête je note :
| 33123456789 |
| 01.23.45.67.89 |
| 01 23 45 67 89 |
| 512345678 |
Je pense que c'est tout
Discussions similaires
- Question
