XL 2010 Couleur plage cellule si résultat < ou >

[laplayast]

Bonsoir,

J'ai crée la forme conditionnelle suivante mais elle n'est pas très claire que j'utilise avec une macro.
Est-ce qu'il y aurai plus simple avec VBA, dans worksheet.(pas de mise en forme conditionnelle ce n'est pas ce que je souhaite).

Si plage<70 en rouge, si >70 en vert.

Merci et bon réveillon.

Range("E71😛74").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=70"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=70"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

 

[Lone-wolf]

Bonsoir laplayast et bonne année à toi aussi 🙂

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("c71:c74")) Is Nothing Then
If Target.Value < 70 Then
Range("e71:p74").Interior.Color = vbRed
Else
Range("e71:p74").Interior.Color = vbGreen
End If
If IsEmpty(Target.Value) Then Range("e71:p74").Interior.Color = xlNone
End If
End Sub

 

[laplayast]

Bonjour et bonne Année 2017 à tous,

Le code suivant et un bon début, mais il ne fonctionne pas quand je calcule avec F9; et comment lui ajouter le recalcul automatique. Je suis avec Excel 2010.
Merci

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E71:Q74")) Is Nothing Then
If Target.Value < 70 Then
Range("E71:Q74").Interior.Color = 3
Else
Range("E71:Q74").Interior.Color = 43
End If
If IsEmpty(Target.Value) Then Range("E71:Q74").Interior.Color = xlNone
End If
End Sub

 

[laplayast]

Bonsoir à tous,
If Target.Value < 70 Then---> cette ligne occasionne une erreur de type 13 et incompatibilité de type.
cela bloque .
Merci de votre aide

 

[herve62]

Bonsoir
Etant sur un truc similaire .. inspire toi de ceci :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("C5:L22")) Is Nothing Then
With Target
If Selection.Interior.ColorIndex = 6 Then
MsgBox " C'est un jour férié , modifiez votre sélection "
Exit Sub
End If
If Selection.Interior.ColorIndex = 3 Then
Selection.Interior.ColorIndex = xlNone
Else
Selection.Interior.ColorIndex = 3
End If
End With
End If
End Sub

Evite le :

If Target.Value < 70 Then--

Vérifie ce truc ?
On n'a pas ton fichier ??? Bizarre !! ... que dis je , Etrange personne ne Réclame ??? ( les anciens on se comprendra )
Je ne m'aventure donc pas plus mais je pense qu'il faudrait faire un SET de ta plage et la mémoriser pour travailler dessus ensuite

Sub Worksheet_BeforeRightClick(ByVal Cible As Range, Cancel As Boolean)
If MemInh = True Or Cible.Interior.ColorIndex = 24 _
                         Or Not Intersect(Cible, Range("PlageJourDate")) Is Nothing _
                         Or Not Intersect(Cible, Range("PlageFeries")) Is Nothing Then Exit Sub       ' Pour ne pas modifier jours fériés ni col. Jour/date
If Not Intersect(Cible, Range("PlageAbs")) Is Nothing Then
        Set MemCible = Cible  ' la plage est mémorisée pour USAGE futur

Verifie aussi tes codes Couleur ( ça change vite si pas STANDARD)

 

[laplayast]

Bonsoir,

Je n'arrive pas à créer le code qui fonctionne. Ce que je souhaite simplement si une plage de données est < à 70, elle passe en rouge si > à 70 en vert; cela dans une worksheet.
Merci.

Code après modif, ne fonctionne pas?

Private Sub Worksheet_Change(ByVal Target As Range)
'If Not Application.Intersect(Target, Range("E71:Q74")) Is Nothing Then
'If Target.Value < 70 Then
'Range("E71:Q74").Interior.Color = 3
'Else
'Range("E71:Q74").Interior.Color = 43
'End If
'If IsEmpty(Target.Value) Then Range("E71:Q74").Interior.Color = xlNone
'End If
'End Sub

 

[laplayast]

Bonsoir à tous,

Je n'arrive pas créer le code, voir post du dessus.

Merci de votre aide.