aide création d'une boucle (resolu par Dranreb )

[fan2foot]

bonsoir,

Pour le bon fonctionnement de mon fichier, je viens de créer un code mais il est très long et très répétitif.
Je sais qu'il existe la méthode de boucle mais je ne la maîtrise pas.
Si quelqu'un pourrait m'aider et en même temps me donner un cour, je suis preneur.
voici le code :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'--- Déclaration des variables
Dim llProno As Long
Dim fResul As Worksheet, fProno As Worksheet
Dim rProno As Range
Dim dResul As Object
'--- On enregistre les variables
Set fProno = Feuil2
Set fResul = Feuil3

If Not Application.Intersect(Target, Range("b2:b100")) Is Nothing Then
    If fResul.Range("c2").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("b2:b100")) >= 1 Then
        Range("b2:b" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("b2:b" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("c2:c100")) Is Nothing Then
    If fResul.Range("c3").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("c2:c100")) >= 1 Then
        Range("c2:c" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("c2:c" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("d2:d100")) Is Nothing Then
    If fResul.Range("c4").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("d2:d100")) >= 1 Then
        Range("d2:d" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("d2:d" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("e2:e100")) Is Nothing Then
    If fResul.Range("c5").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("e2:e100")) >= 1 Then
        Range("e2:e" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("e2:e" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("f2:f100")) Is Nothing Then
    If fResul.Range("c6").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("f2:f100")) >= 1 Then
        Range("f2:f" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("f2:f" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("g2:g100")) Is Nothing Then
    If fResul.Range("c7").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("g2:g100")) >= 1 Then
        Range("g2:g" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("g2:g" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("h2:h100")) Is Nothing Then
    If fResul.Range("c8").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("h2:h100")) >= 1 Then
        Range("h2:h" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("h2:h" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("i2:i100")) Is Nothing Then
    If fResul.Range("c9").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("i2:i100")) >= 1 Then
        Range("i2:i" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("i2:i" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("j2:j100")) Is Nothing Then
    If fResul.Range("c10").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("j2:j100")) >= 1 Then
        Range("j2:j" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("j2:j" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If

If Not Application.Intersect(Target, Range("k2:k100")) Is Nothing Then
    If fResul.Range("c11").Value = "Annulé" And Application.WorksheetFunction.CountA(Range("k2:k100")) >= 1 Then
        Range("k2:k" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = 3
       Else: Range("k2:k" & Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlColorIndexNone
End If
End If
End Sub

si vous préférez le voir dans le fichier, je joint le fichier en pj, le code se trouve sur la feuil2 "pronostic"

 

[Dranreb]

Re : aide création d'une boucle

Bonsoir.
Il n'y a pas de boucle à écrire juste déclarer Col As Range, Tester :
If Not Application.Intersect(Target, Range("b2:k100")) Is Nothing Then
Éventuellement ajouter And Target.Columns.Count = 1 And Target.Rows.Count = 1
Faire d'abord:
[B2:K100].Interior.ColorIndex = xlColorIndexNone
Puis:
Set Col = Intersect([B2:K100], Target.EntireColumn)
Travailler sur cette variable Col.
Col.Resize(Col.Rows(102).End(xlUp).Row - 1).Interior.ColorIndex = 3

Remarque: [B2:K100] revient un peu souvent, vous auriez peut être intérêt à l'affecter aussi d'abord à une autre variable As Range.

 

[fan2foot]

Re : aide création d'une boucle

Bonjour,

Merci de ton aide j'ignorer l’existence de cette méthode, je viens d'apprendre quelque chose.
Cependant je rencontre quelques soucis.

J'ai un message d'erreur si la plage est vide.

Je ne peux pas colorer plus d'une plage, ce qui est dérangeant car à l'utilisation il sera probable qu'il y ait les condition réuni pour que plusieurs plages soit colorer en même temps.

Et puis la condition

If fResul.Range("c2").Value = "Annulé"

n'est pas traité. Cette fois il faut bien utiliser la méthode de boucle non ?

 

[Dranreb]

Re : aide création d'une boucle

Bonjour.
Oui. Quelque chose comme ça :

Dim Plage As Range, Col As Range, NbL As Long
Set Plage = [B2:K100]
If Intersect(Plage, Target) Is Nothing Then Exit Sub
Plage.Interior.ColorIndex = xlColorIndexNone
For Each Col In Intersect(Plage, Target.EntireColumn).Columns
   If Feuil3.Cells(Col.Column, "C").Value = "Annulé" Then
      NbL = Col.Rows(Col.Rows.Count + 1).End(xlUp).Row - 1
      If NbL >= 1 Then Col.Resize(NbL).Interior.ColorIndex = 3
      End If: Next Col

 

[fan2foot]

Re : aide création d'une boucle

après plusieurs essai de manipulation de ton code, je n'y arrive toujours pas. Le seul problème que j'ai réussi à résoudre c'est qu'il puisse y avoir plusieurs colonne en rouge en même temps.
Pour ce faire j'ai mis la ligne

Plage.Interior.ColorIndex = xlColorIndexNone

à la fin en rajoutant la mention else. Mais même là ce n'est pas une total réussite car si la plage en question est vide elle reste toujours rouge, elle ne se dé colorise pas. Je ne comprend pas, parce que le nbl du code (NbL = Col.Rows(Col.Rows.Count + 1).End(xlUp).Row - 1) devrait être égal a zero et donc if est faux et on prend en compte la mention else.

Et puis je viens de remarquer un autre problème, si je double clic ailleurs sur la feuille, les colonnes se dé colorise et ceux quelques soit leur état.

 

[Dranreb]

Re : aide création d'une boucle

Ben oui, c'est normal que ça ne se décolorise plus si vous avez déplacé l'instruction qui décolorisait tout…

 

[fan2foot]

Re : aide création d'une boucle

le problème par rapport a votre code originel c'est qu'il ne peux pas y avoir deux colonnes en rouge en même temps.
J'ai alors essayer de le modifier, mais c'est un echec. Et je ne comprend pas pourquoi sa ne marche pas comme je le souhaiterais.

 

[Dranreb]

Re : aide création d'une boucle

Si mais il faut que ces deux colonnes soient changées en même temps. Ce n'est pas ce qu'il fallait ?
Peut être faut il traiter toutes les colonnes quelles que soient celles changées ? Faire :
For Each Col In Plage.Columns au lieu de :
For Each Col In Intersect(Plage, Target.EntireColumn).Columns

 

[fan2foot]

Re : aide création d'une boucle

Bonjour,

Je suis désolé pour mes explications "moyenne", ce qui doit vont compliquer la tache pour m'aider.
Mais sachez que j'essaie d’être le plus clair possible.

Les valeur qui se trouvent dans les plages sont rempli manuellement et sont voué a évoluer régulièrement.

Et la actuellement si je modifie une plage ( j'ajoute ou enlève une valeur) qui n'est pas colorer je perd la coloration des autres plages qui elle était colorer, alors que les conditions pour quelle soit colorer sont toujours vrai.

Pour expliquer différemment je souhaiterais que tant que les conditions sont vrai pour que la ou les colonne(s) soit coloré en rouge elle(s) reste(nt) coloré et rouge quelques soit les action que je fasse sur les plages adjacente.

pour le code

For Each Col In Plage.Columns

à remplacer dans l'ancien, je n'ai pas réussi à le faire marcher. J'ai plusieurs test et il ne se passe rien, aucune colonne ne se colorise.

 

[Dranreb]

Re : aide création d'une boucle

Mettez un point d'arrêt et déroulez en pas à pas pour essayer de comprendre pourquoi une colonne qui devrait se colorer ne se colore pas. Mettez un espion sur NbL.

 

[fan2foot]

Re : aide création d'une boucle

Bonsoir,

J'ai trouvé mon erreur, il s’agissait d'une faute de frappe de ma part.
Votre code lui marchait très bien.
Un grand merci pour votre aide.