Colorier cellule en blanc si 4 zéro suivent

[garrec]

Bonjour

J'ai un code VBA qui colorie une cellule en fonction dune condition. Il fonctionne parfaitement
Le voici

Sub CommandButton1_Click()
 'On remplace "Index" par "INDEX"
 Cells.Select
     With Application.FindFormat.Font
         .Subscript = False
         .TintAndShade = 0
     End With
     Selection.Replace What:="index", Replacement:="INDEX", LookAt:=xlPart, _
         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
         ReplaceFormat:=False
 'On lance la recherche des paramètre présents dans un tableau mais pas dans l'autre
 For i = 5 To 21
 For j = 5 To 21
 'Dans le tableau 1
 If Range("H" & i) <> Range("O" & j) Then
 'On efface la couleur de la cellule
 Range("H" & i).Interior.ColorIndex = xlColorIndexNone
 'On colorie la cellule en rouge
 Range("H" & i).Interior.ColorIndex = 3
 End If
 'Dans le tableau 2
 If Range("H" & i) <> Range("O" & j) Then
 'On efface la couleur de la cellule
 Range("O" & j).Interior.ColorIndex = xlColorIndexNone
 'On colorie la cellule en rouge
 Range("O" & j).Interior.ColorIndex = 3
 End If
 Next j
 Next i
 'Pour les codes bloom égaux, on va rechercher les différences dans les colones suivantes
 For k = 5 To 21
 For l = 5 To 21
 p = Range("H" & k) = Range("O" & l) And Range("I" & k) <> Range("P" & l)
 Q = Range("H" & k) = Range("O" & l) And Range("J" & k) <> Range("Q" & l)
 R = Range("H" & k) = Range("O" & l) And Range("K" & k) <> Range("R" & l)
 S = Range("H" & k) = Range("O" & l) And Range("L" & k) <> Range("S" & l)
 'Si les codes bloom sont les mêmes mais qu'il y à des différence dans les colones suivante, on colore les cellules en orange
 If p Or Q Or R Or S Then
 Range("H" & k).Interior.ColorIndex = xlColorIndexNone
 Range("H" & k).Interior.ColorIndex = 45
 Range("O" & l).Interior.ColorIndex = xlColorIndexNone
 Range("O" & l).Interior.ColorIndex = 45
 End If
 'Dans chaque ligne ou on a colorer le code bloom en orange, on colorie les variations
 If p Then
 Range("I" & k).Interior.ColorIndex = xlColorIndexNone
 Range("I" & k).Interior.ColorIndex = 45
 Range("P" & l).Interior.ColorIndex = xlColorIndexNone
 Range("P" & l).Interior.ColorIndex = 45
 End If
 If Q Then
 Range("J" & k).Interior.ColorIndex = xlColorIndexNone
 Range("J" & k).Interior.ColorIndex = 45
 Range("Q" & l).Interior.ColorIndex = xlColorIndexNone
 Range("Q" & l).Interior.ColorIndex = 45
 End If
 If R Then
 Range("K" & k).Interior.ColorIndex = xlColorIndexNone
 Range("K" & k).Interior.ColorIndex = 45
 Range("R" & l).Interior.ColorIndex = xlColorIndexNone
 Range("R" & l).Interior.ColorIndex = 45
 End If
 If S Then
 Range("L" & k).Interior.ColorIndex = xlColorIndexNone
 Range("L" & k).Interior.ColorIndex = 45
 Range("S" & l).Interior.ColorIndex = xlColorIndexNone
 Range("S" & l).Interior.ColorIndex = 45
 End If
 Next l
 Next k
 For n = 5 To 21
 For m = 5 To 21
 T = Range("H" & n) = Range("O" & m) And Range("I" & n) = Range("P" & m) And Range("J" & n) = Range("Q" & m) And Range("K" & n) = Range("R" & m) And Range("L" & n) = Range("S" & m)
 'Dans le tableau 1
 If T Then
 'On efface la couleur de la plage de cellule
 Range("H" & n, "L" & n).Interior.ColorIndex = xlColorIndexNone
 End If
 'Dans le tableau 2
 If T Then
 'On efface la couleur de la plage de cellule
 Range("O" & m, "S" & m).Interior.ColorIndex = xlColorIndexNone
 End If
 Next m
 Next n
 Range("A1").Select
 
 

 End Sub

Tout cela fonctionne tres bien. Mais maintenant j'aimerais que certaines cellules redeviennent blanches c a d si 4 zéro suivent dans le tableau. J'ai fait un example dans la piece jointe . Voici le code que j'ai essayé mais il ne fonctione pas?

Sub ess()
 
 For i = 5 To 21
 
 If Range("P" & i).Value = "0" & Range("Q" & i).Value = "0" & Range("R" & i).Value = "0" & Range("S" & i).Value = "0" Then
 
 Range("O" & i).Interior.ColorIndex = xlColorIndexNone
 
 
 
 End If

Quelqu'un voit pourquoi?

J'ai joint un fichier simple c'est toujours plus explicit 🙂

Merci

Next



End Sub

 

[tototiti2008]

Re : Colorier cellule en blanc si 4 zéro suivent

Bonjour garrec,

essaie de remplacer la ligne

If Range("P" & i).Value = "0" & Range("Q" & i).Value =  "0" & Range("R" & i).Value = "0" & Range("S" & i).Value  = "0" Then

par

If Range("P" & i).Value = 0 and Range("Q" & i).Value = 0 and Range("R" & i).Value = 0 and Range("S" & i).Value  = 0 Then

& est l'opérateur de concaténation, met And pour l'opérateur logique
Pour les valeurs numériques, évite les guillemets, réserve les pour les valeurs de type Texte

 

[garrec]

Re : Colorier cellule en blanc si 4 zéro suivent

thanks a lot. Perfecto