Conditionnalités à + de 3 conditions

Bonjour à tous,

Dans le cadre de mon travail je dois traités des données nombreuses à 5 conditions.J'aimerais que la cellule se colorise différemment suivant la donné rentrée.

Par exemple si la valeur est inf. à 1 que la cellule soit en bleu,si la valeur est comprit entre 1 et 2 que la cellule soit verte,entre 2 et 3 qu'elle sot jaune, entre 3 et 4 qu'elle soit orange et sup. à 4 qu'elle soit rouge...

Mon grand malheur c'est que le format de conditionnalité d'excel (version 2003) n'accepte que jusqu'à 3 contions (en gros je pourrais choisir que ma cellule soit bleu,verte ou jaune par ex)...

Si vous voulez bien m'aider,je vous en serait fort reconnaissant

Belen

Bonjour,

Essaye cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
  With Target
  If Target < 1 Then
    .Interior.ColorIndex = 33
  ElseIf Target >= 1 And Target < 2 Then
    .Interior.ColorIndex = 4
    ElseIf Target >= 2 And Target < 3 Then
     .Interior.ColorIndex = 6
    ElseIf Target >= 3 And Target < 4 Then
    .Interior.ColorIndex = 45
    Else
      .Interior.ColorIndex = 3
  End If
End With
End Sub

Code à placer en VBA dans la feuille où se trove la cellule à colorer.

Pour l'exemple j'ai considéré que la cellule A1 à mettre en couleur.

Amicalement

Dan

Nad-Dan a écrit :

Bonjour,

Essaye cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
  With Target
  If Target < 1 Then
    .Interior.ColorIndex = 33
  ElseIf Target >= 1 And Target < 2 Then
    .Interior.ColorIndex = 4
    ElseIf Target >= 2 And Target < 3 Then
     .Interior.ColorIndex = 6
    ElseIf Target >= 3 And Target < 4 Then
    .Interior.ColorIndex = 45
    Else
      .Interior.ColorIndex = 3
  End If
End With
End Sub

Code à placer en VBA dans la feuille où se trove la cellule à colorer.

Pour l'exemple j'ai considéré que la cellule A1 à mettre en couleur.

Amicalement

Dan

La même en plus complexe

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Dim Plage As Range
Dim Zone As Range

Set Zone = Range("A1:B15")
Set Plage = Target
On Error Resume Next
Set Plage = Union(Target, Target.Dependents)
If Err.Number = 1004 Then
    Err.Clear
End If
If Err.Number > 0 Then
    GoTo Err_Worksheet_Change
Else
    On Error GoTo Err_Worksheet_Change
End If

If Intersect(Plage, Zone) Is Nothing Then
    GoTo Sort_Worksheet_Change
Else
    Set Plage = Intersect(Plage, Zone)
End If
For Each Cel In Plage
    If IsNumeric(Cel) Then
        Select Case Cel
            Case Is < 1
                Cel.Interior.ColorIndex = 33
            Case Is < 2
                Cel.Interior.ColorIndex = 4
            Case Is < 3
                Cel.Interior.ColorIndex = 6
            Case Is < 4
                Cel.Interior.ColorIndex = 45
            Case Is >= 4
                Cel.Interior.ColorIndex = 3
        End Select
    End If
Next Cel
Sort_Worksheet_Change:
    Exit Sub
Err_Worksheet_Change:
    MsgBox Err.Description, vbCritical + vbOKOnly, "Erreur n°" & Err.Number
    Resume Sort_Worksheet_Change
End Sub

la définition de zone limite la plage d'interaction de la macro

elle prend en compte les copier/coller et effacement multiple.

elle fait evoluer la couleur des cellules contenant des formules, qui ne sont pas concernées normalement

Enfin, tout ce que j'ai pu penser comme problèmes

A+

merci pour vos (r)enseignements (étant donné que j'y connais rien en prog et en VBA),je vais tenter de placer tout cela aujourd'hui

Belen