[RESOLU]Mise en forme conditionnelle 15 condition / différente cellule

Mise en forme conditionnelle 15 condition / différente cellule [RESOLU] - VB/VBA/VBS - Programmation

Marsh Posté le 27-06-2008 à 09:51:45    

Bonjour tout le monde  
 
Voilà mon problème  
Je veux faire une mise en forme conditionnelle mes avec 15 conditions donc obligation de prendre des macros.
J’ai bien vue le problème des mise en forme conditionnelle pour plus de trois condition qui est pour la même cellule dont mon code modifier est :
 
 

Code :
  1. Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  2.   If Not Intersect(Target, Range("G22:G653" )) Is Nothing Then
  3.     With Target
  4.       Select Case Target.Value
  5.         Case Is < 0
  6.           .Interior.ColorIndex = 1
  7.         Case Is = 0
  8.           .Interior.ColorIndex = 2
  9.         Case Is = 1
  10.           .Interior.ColorIndex = 15
  11.         Case Is = 2
  12.           .Interior.ColorIndex = 6
  13.         Case Is = 3
  14.           .Interior.ColorIndex = 44
  15.         Case Is = 4
  16.           .Interior.ColorIndex = 45
  17.         Case Is = 5
  18.           .Interior.ColorIndex = 46
  19.         Case Is = 6
  20.           .Interior.ColorIndex = 28
  21.         Case Is = 7
  22.           .Interior.ColorIndex = 37
  23.         Case Is = 8
  24.           .Interior.ColorIndex = 42
  25.         Case Is = 9
  26.           .Interior.ColorIndex = 41
  27.         Case Is = 10
  28.           .Interior.ColorIndex = 26
  29.         Case Is = 11
  30.           .Interior.ColorIndex = 2
  31.         Case Is = 12
  32.           .Interior.ColorIndex = 2
  33.         Case Is > 12
  34.           .Interior.ColorIndex = 1
  35.       End Select
  36.     End With
  37.   End If
  38. End Sub


 
Ce que je veux en plus de ce code ses que quand j’écris par exemple 1 dans G22, la case G22 se mettent en gris, mes aussi de I22 à AK22. et ainsi desuite de la ligne 22 a la ligne 653.
 
Autre exemple si j’écris 5 dans G72, G72 passe au orange et I72 à AK72 passe au orange aussi.
 
Si je dois passer 24h a programmer mon truc avec une formule qui fait plus de 10 000 lignes (rendement de 20 ligne pour chaque ligne de la ligne 22 à 653) ses pas grave mes j’aimerais cette formule. après ses sur si vous avez un formule vraiment plus courte sa m’intéresse lol  :sweat:  .
 
Merci de vos réponse.


Message édité par ricardo cardo le 27-06-2008 à 11:34:48

---------------
-VIP- J.cedric Super Admin de la team des Viperes
Reply

Marsh Posté le 27-06-2008 à 09:51:45   

Reply

Marsh Posté le 27-06-2008 à 10:50:07    

bonjour,
a adapter
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not Intersect(Target, Range("G22:G653" )) Is Nothing Then
    With Target
      Select Case Target.Value
        Case Is < 0
          .Interior.ColorIndex = 1
          Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column + 30)).Interior.ColorIndex = 1
        Case Is = 0
etc.....

Reply

Marsh Posté le 27-06-2008 à 10:58:11    

Sa marche super bien le seul problème est que sa m'efface les couleurs de la colonne H qui elle en est pour rien lol s'il y avait un truc


---------------
-VIP- J.cedric Super Admin de la team des Viperes
Reply

Marsh Posté le 27-06-2008 à 11:14:45    

J'ai repris le code de 86vomito33 et j'ai un peu améliorer. J'ai créé une fonction qui renvoie le paramétrage, comme ca si tu veux modifier qqch, tu le modifies une seul fois et c'est tout...
 

Code :
  1. Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  2.   If Not Intersect(Target, Range("G22:G653" )) Is Nothing Then
  3.     With Target
  4.       Select Case Target.Value
  5.         Case Is < 0
  6.           Call Coloriser_cellule(Target, 1)
  7.         Case Is = 0
  8.           Call Coloriser_cellule(Target, 2)
  9.         Case Is = 1
  10.           Call Coloriser_cellule(Target, 15)
  11.         Case Is = 2
  12.           Call Coloriser_cellule(Target, 6)
  13.         Case Is = 3
  14.           Call Coloriser_cellule(Target, 44)
  15.         Case Is = 4
  16.           Call Coloriser_cellule(Target, 45)
  17.         Case Is = 5
  18.           Call Coloriser_cellule(Target, 46)
  19.         Case Is = 6
  20.           Call Coloriser_cellule(Target, 28)
  21.         Case Is = 7
  22.           Call Coloriser_cellule(Target, 37)
  23.         Case Is = 8
  24.           Call Coloriser_cellule(Target, 42)
  25.         Case Is = 9
  26.           Call Coloriser_cellule(Target, 41)
  27.         Case Is = 10
  28.           Call Coloriser_cellule(Target, 26)
  29.         Case Is = 11
  30.           Call Coloriser_cellule(Target, 2)
  31.         Case Is = 12
  32.           Call Coloriser_cellule(Target, 2)
  33.         Case Is > 12
  34.           Call Coloriser_cellule(Target, 1)
  35.       End Select
  36.     End With
  37.   End If
  38. End Sub
  40. Public Function Coloriser_cellule(ByVal Target_cellule As Excel.Range, ByVal couleur As Single)
  41.     Target_cellule.Interior.ColorIndex = couleur
  42.     Range(Cells(Target_cellule.Row, Target_cellule.Column + 2), Cells(Target_cellule.Row, Target_cellule.Column + 30)).Interior.ColorIndex = couleur
  43. End Function



---------------
Feedback : http://forum.hardware.fr/hfr/Achat [...] 2666_1.htm
Reply

Marsh Posté le 27-06-2008 à 11:24:11    

je tien a vous remercier tout les deux super boulot rien a dire 20/20 en plus super rapide  :sol:


---------------
-VIP- J.cedric Super Admin de la team des Viperes
Reply

Marsh Posté le 29-06-2008 à 14:06:40    

Pour résumer...

Code :
  1. Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  2.   If Not Intersect(Target, Range("G22:G653" )) Is Nothing Then
  3.     With Target
  4.       Select Case .Value
  5.         Case Is < 0: i = 1
  6.         Case Is = 0: i = 2
  7.         Case Is = 1: i = 15
  8.         Case Is = 2: i = 6
  9.         Case Is = 3: i = 44
  10.         Case Is = 4: i = 45
  11.         Case Is = 5: i = 46
  12.         Case Is = 6: i = 28
  13.         Case Is = 7: i = 37
  14.         Case Is = 8: i = 42
  15.         Case Is = 9: i = 41
  16.         Case Is = 10: i = 26
  17.         Case Is = 11: i = 2
  18.         Case Is = 12: i = 2
  19.         Case Is > 12: i = 1
  20.       End Select
  21.       .Interior.ColorIndex = i
  22.       .Offset(, 2).Resize(, 29).Interior.ColorIndex = i
  23.     End With
  24.   End If
  25. End Sub


A+

Reply

Marsh Posté le 30-06-2008 à 10:25:32    

héhé... Pas mieux...


---------------
Feedback : http://forum.hardware.fr/hfr/Achat [...] 2666_1.htm
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed