Macro MEFC plus de 3 conditions sous excel 2003

C'est exactement ce que je cherche à faire, avec un peu de traduction en code, tu résoudrais mes questions.


Merci beaucoup

Si tu pouvais joindre un fichier exemple avec quelques données bidons, ça aiderait à mieux comprendre et à t'aider...

Voilà ce que je voudrais

Code du message #8 modifié
Ce ne serait pas ça que tu veux ?
NB: ton fichier joint n'était pas très clair, du moins pour moi...

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

Sub formatConditionnelle() Application.ScreenUpdating = False For Each c In [BH2:BH250] 'plage a tester If c.Value = "A" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 8 c.offset(0,6).Interior.ColorIndex = 8 ElseIf c.Value = "B" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 9 c.offset(0,6).Interior.ColorIndex = 9 ElseIf c.Value = "C" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 3 c.offset(0,6).Interior.ColorIndex = 3 ElseIf c.Value = "D" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 4 c.offset(0,6).Interior.ColorIndex = 4 ElseIf c.Value = "E" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 10 c.offset(0,6).Interior.ColorIndex = 10 ElseIf c.Value = "F" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 6 c.offset(0,6).Interior.ColorIndex = 6 ElseIf c.Value = "G" And c.Offset(0, 9) <> "" Then c.Interior.ColorIndex = 7 c.offset(0,6).Interior.ColorIndex = 7 Else c.Interior.ColorIndex = xlColorIndexAutomatic c.offset(0,6).Interior.ColorIndex = xlColorIndexAutomatic End If Next Application.ScreenUpdating = True Range("BH2").Select End Sub

---

Bonjour Parmi et Kestion,

Oui c'est ce qu'il veut.

Avec mon code cela donne le résultat attendu.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Sub formatConditionnelle()   couleur = [{"A",8;"B",9;"C",3;"D",4;"E",10;"F",6;"G",7}] 'fonction evaluate Application.ScreenUpdating = False   For Each C In [BH2:BH250] 'plage a testée For lig = LBound(couleur, 1) To UBound(couleur, 1) If C = couleur(lig, 1) And C.Offset(0, 9) <> "" Then C.Interior.ColorIndex = couleur(lig, 2) C.Offset(0, 6).Interior.ColorIndex = couleur(lig, 2) End If Next lig Next   Application.ScreenUpdating = True   End Sub

---

Mais tout cela ne sert à rien si le résultat reste aléatoire avec des adresses mail en lieu et place des "A", "B", "C" ....

J'ajoute que la solution avec "evaluate" ou "elseif" (select case serait d'ailleurs plus adaptés) est très discutable pour des adresses en grand nombre.

Me souvenant d'une discussion pas très éloignée sur un dégradé de couleur, je me demande si le code ci-dessous ne suffirait pas à ton bonheur.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub degrade_couleur()   Dim j As Integer Dim couleur As integer   couleur = 1   derlig = range("bh650000").end(xlup).row Application.ScreenUpdating = False   for j = 2 to derlig   If InStr(1, Range("BH" & j).Value, "@") <> 0 And Range("BQ" & j).Value <> "" Then couleur = couleur + 1 Range("BH" & j).Interior.ColorIndex = couleur Range("BN" & j).Interior.ColorIndex = couleur End If   next j Application.ScreenUpdating = False   End Sub

---

Attention : s'il y a plus de 56 adresse mail, il faudra que couleur soit réinitialisé à 2.
cela est vrai quel que soit le code adopté.
cordialement,

Le code de PARMI a l'air de bien répondre au problème posé.
Je fais tourner et reviens.

PARFAIT!!!