Qui m'aide à faire une boucle

bomagicmusic

XLDnaute Occasionnel
Bonjour à tous,

J'ai un code ci-dessous qui en fonction de la valeur de la colonne J (de la ligne 7 à 31) me colorie le texte de la colonne N (ligne 7 à 31)en vert, orange ou rouge. ça marche pour la première ligne et je voudrais faire une boucle sur les lignes 7 à 31 qui peux m'aider?

Merci

Private Sub CommandButtonIndicateurs_Click()

Range("J7:J31").Select 'Permet de selectionner plusieurs cellules
Range("N7:N31").Select
For Each Cell In Selection 'Pour chaque cellule dans la selection
If Cells(7, 10).Value < 10 Then
Cells(7, 14).Font.ColorIndex = 4 'Colorie le texte en 4=vert
End If
If Cells(7, 10).Value > 10 And Cells(7, 10).Value < 30 Then
Cells(7, 14).Font.ColorIndex = 44
End If
If Cells(7, 10).Value > 30 Then
Cells(7, 14).Font.ColorIndex = 3
End If
Next
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : Qui m'aide à faire une boucle

Bonsoir

essaye peut être comme ceci :

Code:
Private Sub CommandButtonIndicateurs_Click()
Dim c As Range
For Each c In Range("J7:J31")
    If c.Value < 10 Then
        c.Offset(0, 4).Font.ColorIndex = 4
        ElseIf c.Value >= 10 And c.Value < 30 Then c.Offset(0, 4).Font.ColorIndex = 44
        ElseIf c.Value >= 30 Then c.Offset(0, 4).Font.ColorIndex = 3
    End If
Next
End Sub

bonne soirée
@+

Edition : modifié un "cells" qui trainait...
 
Dernière édition:

Etienne2323

XLDnaute Impliqué
Re : Qui m'aide à faire une boucle

Bonsoir bomagicmusic, Pierrot, le forum

vous pouvez toujours essayer quelque chose comme ceci :

Code:
Sub Test()

Dim Valeur As Double

For i = 7 To 31
    Valeur = Cells(i, 10).Value
    Select Case Valeur
    Case 0 To 10
        Cells(i, 14).Font.ColorIndex = 4
    Case 11 To 30
        Cells(i, 14).Font.ColorIndex = 44
    Case 30 To 100000000
        Cells(i, 14).Font.ColorIndex = 3
    End Select
Next i

 
End Sub

Bonne fin de soirée,

Cordialement,

Étienne
 

bomagicmusic

XLDnaute Occasionnel
Re : Qui m'aide à faire une boucle

Bonjour Pierrot,

C'est presque parfait (dire que ça fait des jours que je retourne le code dans tous les sens...)
Il y a juste la condition ElseIf c.Value >= 10 And Cells(7, 10).Value < 30 Then c.Offset(0, 4).Font.ColorIndex = 44 qui ne marche pas ça devrait faire du orange et là rien. t'as une idée?
 

ROGER2327

XLDnaute Barbatruc
Re : Qui m'aide à faire une boucle

Bonsoir à tous.
Une solution du même genre, adaptable à d'autres situations :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="DarkOrange"]'Doit être placé dans le module de la feuille concernée.[/COLOR]
    If Not Intersect(Target, Me.Range("J7:J31")) Is Nothing Then COLORIE Intersect(Target, Me.Range("J7:J31")), 0, 4
End Sub

Sub COLORIE(p As Range, Optional cl As Long, Optional cc As Long)
[COLOR="DarkOrange"]'Peut être placé dans un module standard pour être appelé depuis plusieurs feuilles.[/COLOR]
Dim c, CV
    For Each c In p
        CV = c.Value
        With c.Offset(cl, cc).Font
            .ColorIndex = xlAutomatic
            If IsNumeric(CV) And Not IsEmpty(CV) Then
                Select Case CV
                Case Is <= 10: .ColorIndex = 4
                Case Is <= 30: .ColorIndex = 44
                Case Else: .ColorIndex = 3
                End Select
            End If
        End With
    Next c
End Sub
Bonne soirée,
ROGER2327