Mettre en forme une plage de cellule selon le libellé en ligne 1

Essaie la macro ainsi modifiée :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
Arr3 = Array(Chr(160), Chr(32), ".", "-", "(", ",")

For i = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
NumCol = Application.Match(Cells(1, i), Arr1, 0)
Range(Cells(2, i), Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsNumeric(Application.Match(Cells(1, j), Arr2, 0)) Then
NumCol = Application.Match(Cells(1, j), Arr2, 0)
End If
Set ZoneSelection = Sheets(1).Range(Cells(2, j), Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) -
(Len(C.Value) - 9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or
Len(C) <> 9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j

End Sub

Daniel

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu recopies une
cellule ailleurs (si ça a une importance ?).
Daniel

Ben, on peut faire tout cela avec une MEFC .....

--
Bien amicalmement,
"Le vin est au repas ce que le parfum est à la femme."

Bonsoir,

Les cellules ou plages de cellules ne seront pas recopiées une fois la mise
en forme exécutée.
Là, je bute sur un autre problème avec le tableau.
Je cherche à supprimer dans les plages de cellules (Tel, gsm, Fax) des
caractères indésirables (Arr3).
Je pense que mes structures de contrôles ne sont pas bien positionnées et
notamment For j To ..., car j'ai une erreur d'exécution 091 qui s'affiche.
Comme je débute ...

Si vous aviez le temps de vou pencher sur le problème.
Merci d'avance.


Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
Arr3 = Array(Chr(160), Chr(32), ".", "-", "(", ",")

For i = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
NumCol = Application.Match(Cells(1, i), Arr1, 0)
Range(Cells(2, i), Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
NumCol = Application.Match(Cells(1, j), Arr2, 0)
Set ZoneSelection = Sheets(1).Range(Cells(2, j), Cells(1000,
j).End(xlUp))
With ZoneSelection
.NumberFormat = "@"
For Each elt In Arr3
.Cells.Replace elt, ""
Next elt
For Each C In .Cells
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) -
(Len(C.Value) - 9))
Next C
For Each C In .Cells
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C) <>
9 Then C.Value = ""
Next C
For Each C In .Cells
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C
End With
Next j

End Sub

Daniel.C a exprimé avec précision :

Essaie la macro ainsi modifiée :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
Arr3 = Array(Chr(160), Chr(32), ".", "-", "(", ",")

For i = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
NumCol = Application.Match(Cells(1, i), Arr1, 0)
Range(Cells(2, i), Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsNumeric(Application.Match(Cells(1, j), Arr2, 0)) Then
NumCol = Application.Match(Cells(1, j), Arr2, 0)
End If
Set ZoneSelection = Sheets(1).Range(Cells(2, j), Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) - (Len(C.Value) -
9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C) <>
9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j

End Sub

Daniel

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu recopies
une cellule ailleurs (si ça a une importance ?).
Daniel

Bonsoir,
Merci pour cette réponse rapide, mais le problème demeure
malheureusement.
Si j'exécute la procédure d'un bloc, comme ci-dessus, c'est la ligne
For i = ... qui est pointée en jaune dans me fenêtre vba.
Si j'isole la structure For i = ... dans une procédure propre, elle
fonctionne. La structure For j = ... dans une procédure propre quant a
elle génère l'erreur 91.
Cordialement

Daniel.C a exprimé avec précision :

Essaie la macro ainsi modifiée :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
Arr3 = Array(Chr(160), Chr(32), ".", "-", "(", ",")

For i = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
NumCol = Application.Match(Cells(1, i), Arr1, 0)
Range(Cells(2, i), Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = Cells(1, Cells.Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsNumeric(Application.Match(Cells(1, j), Arr2, 0)) Then
NumCol = Application.Match(Cells(1, j), Arr2, 0)
End If
Set ZoneSelection = Sheets(1).Range(Cells(2, j), Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) - (Len(C.Value)
- 9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C)
<> 9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j

End Sub

Daniel

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu recopies
une cellule ailleurs (si ça a une importance ?).
Daniel

Bonsoir,
Merci pour cette réponse rapide, mais le problème demeure malheureusement.
Si j'exécute la procédure d'un bloc, comme ci-dessus, c'est la ligne For i =
... qui est pointée en jaune dans me fenêtre vba.
Si j'isole la structure For i = ... dans une procédure propre, elle
fonctionne. La structure For j = ... dans une procédure propre quant a elle
génère l'erreur 91.
Cordialement

Je pense que ça vient de l'agencement de tes données.
Peux-tu charger ton classeur sur www.cjoint.com en effaçant les données
confidentielles ? Poste ensuite ici le lien généré.
Daniel

Daniel.C a couché sur son écran :

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu recopies
une cellule ailleurs (si ça a une importance ?).
Daniel

Bonsoir,
Merci pour cette réponse rapide, mais le problème demeure malheureusement.
Si j'exécute la procédure d'un bloc, comme ci-dessus, c'est la ligne For i
= ... qui est pointée en jaune dans me fenêtre vba.
Si j'isole la structure For i = ... dans une procédure propre, elle
fonctionne. La structure For j = ... dans une procédure propre quant a elle
génère l'erreur 91.
Cordialement

Je pense que ça vient de l'agencement de tes données.
Peux-tu charger ton classeur sur www.cjoint.com en effaçant les données
confidentielles ? Poste ensuite ici le lien généré.
Daniel

Bonsoir,
Voici le le fichier via http://dl.free.fr/lwUnZPemY
Cordialement.

Daniel.C a couché sur son écran :

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu recopies
une cellule ailleurs (si ça a une importance ?).
Daniel

Bonsoir,
Merci pour cette réponse rapide, mais le problème demeure malheureusement.
Si j'exécute la procédure d'un bloc, comme ci-dessus, c'est la ligne For i
= ... qui est pointée en jaune dans me fenêtre vba.
Si j'isole la structure For i = ... dans une procédure propre, elle
fonctionne. La structure For j = ... dans une procédure propre quant a
elle génère l'erreur 91.
Cordialement

Je pense que ça vient de l'agencement de tes données.
Peux-tu charger ton classeur sur www.cjoint.com en effaçant les données
confidentielles ? Poste ensuite ici le lien généré.
Daniel

Bonsoir,
Voici le le fichier via http://dl.free.fr/lwUnZPemY
Cordialement.

Je n'ai pas compris pourquoi, mais, bon, il y a un contournement. Mets
la macro dans un module standard :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Application.ScreenUpdating = False
Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
With ActiveCell
For i = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1
Step -1
NumCol = Application.Match(.Cells(1, i), Arr1, 0)
Range(.Cells(2, i), .Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1
Step -1
If IsNumeric(Application.Match(.Cells(1, j), Arr2, 0)) Then
NumCol = Application.Match(.Cells(1, j), Arr2, 0)
End If
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) -
(Len(C.Value) - 9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or
Len(C) <> 9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j
End With
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel

Oups. Ne l'exécute pas, elle efface tout !
Daniel

Daniel.C a couché sur son écran :

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu
recopies une cellule ailleurs (si ça a une importance ?).
Daniel

Bonsoir,
Merci pour cette réponse rapide, mais le problème demeure
malheureusement.
Si j'exécute la procédure d'un bloc, comme ci-dessus, c'est la ligne For
i = ... qui est pointée en jaune dans me fenêtre vba.
Si j'isole la structure For i = ... dans une procédure propre, elle
fonctionne. La structure For j = ... dans une procédure propre quant a
elle génère l'erreur 91.
Cordialement

Je pense que ça vient de l'agencement de tes données.
Peux-tu charger ton classeur sur www.cjoint.com en effaçant les données
confidentielles ? Poste ensuite ici le lien généré.
Daniel

Bonsoir,
Voici le le fichier via http://dl.free.fr/lwUnZPemY
Cordialement.

Je n'ai pas compris pourquoi, mais, bon, il y a un contournement. Mets la
macro dans un module standard :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Application.ScreenUpdating = False
Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
With ActiveCell
For i = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1 Step
-1
NumCol = Application.Match(.Cells(1, i), Arr1, 0)
Range(.Cells(2, i), .Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1 Step
-1
If IsNumeric(Application.Match(.Cells(1, j), Arr2, 0)) Then
NumCol = Application.Match(.Cells(1, j), Arr2, 0)
End If
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) - (Len(C.Value) -
9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C) <>
9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j
End With
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel

Remplace par :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Application.ScreenUpdating = False
Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
With ActiveCell
For i = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1
Step -1
' NumCol = Application.Match(.Cells(1, i), Arr1, 0)
Range(.Cells(2, i), .Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1
Step -1
' If IsNumeric(Application.Match(.Cells(1, j), Arr2, 0)) Then
' NumCol = Application.Match(.Cells(1, j), Arr2, 0)
' End If
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
Next C
Next j
For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 28
Step -1
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) -
(Len(C.Value) - 9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or
Len(C) <> 9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j
End With
Application.ScreenUpdating = True
End Sub

Les lignes :

If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) -
(Len(C.Value) - 9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or
Len(C) <> 9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value

s'exécutaient sur toutes les colonnes et supprimaient le contenu des
cellules. Alors que je suppose qu'elles ne doivent s'exécuter que sur
les colonnes 28, 29 et 30. Le problème se complexifie si les colonnes
ne sont pas toujours présentes ou pas toujours au même endroit.

Cordialement.
Daniel

Oups. Ne l'exécute pas, elle efface tout !
Daniel

Daniel.C a couché sur son écran :

Daniel.C vient de nous annoncer :

La seule différence, c'est que tu perds ta mise en forme si tu
recopies une cellule ailleurs (si ça a une importance ?).
Daniel

Bonsoir,
Merci pour cette réponse rapide, mais le problème demeure
malheureusement.
Si j'exécute la procédure d'un bloc, comme ci-dessus, c'est la ligne For
i = ... qui est pointée en jaune dans me fenêtre vba.
Si j'isole la structure For i = ... dans une procédure propre, elle
fonctionne. La structure For j = ... dans une procédure propre quant a
elle génère l'erreur 91.
Cordialement

Je pense que ça vient de l'agencement de tes données.
Peux-tu charger ton classeur sur www.cjoint.com en effaçant les données
confidentielles ? Poste ensuite ici le lien généré.
Daniel

Bonsoir,
Voici le le fichier via http://dl.free.fr/lwUnZPemY
Cordialement.

Je n'ai pas compris pourquoi, mais, bon, il y a un contournement. Mets la
macro dans un module standard :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Application.ScreenUpdating = False
Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
With ActiveCell
For i = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1 Step
-1
NumCol = Application.Match(.Cells(1, i), Arr1, 0)
Range(.Cells(2, i), .Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1 Step
-1
If IsNumeric(Application.Match(.Cells(1, j), Arr2, 0)) Then
NumCol = Application.Match(.Cells(1, j), Arr2, 0)
End If
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) - (Len(C.Value)
- 9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C)
<> 9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j
End With
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel

Daniel.C a pensé très fort :

Remplace par :

Sub MEFcCellule()

Dim Arr1, Arr2, Arr3, i As Integer, j As Integer
Dim elt As Range, C As Range, Cells As Range, ZoneSelection As Range

Application.ScreenUpdating = False
Arr1 = Array("N° Licence")
Arr2 = Array("Tel", "gsm", "Fax")
With ActiveCell
For i = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1 Step
-1
' NumCol = Application.Match(.Cells(1, i), Arr1, 0)
Range(.Cells(2, i), .Cells(1000, i).End(xlUp)).NumberFormat = "0"
Next i

For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 1 Step
-1
' If IsNumeric(Application.Match(.Cells(1, j), Arr2, 0)) Then
' NumCol = Application.Match(.Cells(1, j), Arr2, 0)
' End If
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
ZoneSelection.NumberFormat = "@"
' suppression des caractères parasites
C.Value = Application.Trim(Application.Clean(C.Value))
Next C
Next j
For j = .Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column To 28 Step
-1
Set ZoneSelection = Sheets(1).Range(.Cells(2, j), .Cells(1000,
j).End(xlUp))
For Each C In ZoneSelection
If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) - (Len(C.Value) -
9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C) <>
9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value
Next C

Next j
End With
Application.ScreenUpdating = True
End Sub

Les lignes :

If Len(C) > 9 Then C.Value = Left(C.Value, Len(C.Value) - (Len(C.Value) -
9))
If Left(C.Value, 2) <> "26" And Left(C.Value, 2) <> "69" Or Len(C) <>
9 Then C.Value = ""
If Len(C) = 9 Then C.Value = "0" & C.Value

s'exécutaient sur toutes les colonnes et supprimaient le contenu des
cellules. Alors que je suppose qu'elles ne doivent s'exécuter que sur les
colonnes 28, 29 et 30. Le problème se complexifie si les colonnes ne sont pas
toujours présentes ou pas toujours au même endroit.

Cordialement.
Daniel

Bonjour Daniel,
Merci pour votre aide, mais malheureusement cela ne fonctionne pas.
L'exécution est "hyper" longue et les 3 dernières conditions dans la
boucle For each ne s'exécutent pas.
Concernant votre dernière remarque, je confirme que la procédure devait
s'exécuter sur les 3 dernières colonnes. Que si les colonnes ne sont
plus adjacentes, une seule des 3 est détectée.
Ce n'est pas grave, je vais déclarer par défaut cette plage qui ira de
la 1ère cellule de la 1ère colonne à la dernière cellule de la dernière
pour effectuer la boucle. En croisant les doigts que cette plage
contiendr effectivement les divers numéros de tel, fax, gsm.
Merci pour votre aide.
Cdlt