Modifier couleur d'une cellule selon sa valeur

[spitchz]

Bonjour,

J'ai besoin d'un petit code simple qui change la couleur de la cellule active si > que 0. La macro doit appliquer la même couleur que la cellule en colonne A de la même rangée (les rangées ne sont pas toutes de la même couleur)

Voici le code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cellR   As String                                  'cellule dont la couleur est à changer, adresse de Rangée

    If ActiveCell.Value > 0 Then
        cellR = ActiveCell.Row
        ActiveCell.Interior.ColorIndex = Range("A" & cellR).Interior.ColorIndex
    End If
    If ActiveCell.Value <= 0 Then
        ActiveCell.Interior.ColorIndex = xlNone
    End If
End Sub

Ça fonctionne, le problème c'est que la couleur change seulement lorsque je sélectionne une 2e fois la cellule au lieu de lors du changement de valeur. J'ai essayé avec l'événement Change mais sans succès.

Quelqu'un a une idée?
Merci

 

[tantal_fr]

Bonjour,

L'évènement SelectionChange est déclenché lorsque la selection change et non la valeur.

Autre chose (si tu fait la modif tu verra que ça marche plus), évite de travaillé avec les ActiveCell et utilise les paramètres de la fonction dans laquelle tu te trouve.

 

[zeb]

Mais non, cellR n'est pas une chaîne de caractères, c'est une cellule !
Et sinon, tu connais Else ?

Ah les cellules actives ... Merci tantal !

Ton problème résolu :

If Target.Value > 0 Then
    Target.Interior.ColorIndex = Target.EntireRow.Cells(1).Interior.ColorIndex
Else
    Target.Interior.ColorIndex = xlNone
End If

Allez, juste pour se la pêter :

Target.Interior.ColorIndex = Iif(Target.Value > 0, Target.EntireRow.Cells(1).Interior.ColorIndex, xlNone)

 

[spitchz]

Bonjour,

Merci! Ça fonctionne comme voulu. La modification des couleurs doit s'effectuer dans une plage de cellule seulement, j'ai donc ajouter ces lignes:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D2:I65535")) Is Nothing Then
        If Target.Value > 0 Then
            Target.Interior.ColorIndex = Target.EntireRow.Cells(1).Interior.ColorIndex
        Else
            Target.Interior.ColorIndex = xlNone
        End If
End If
End Sub

Ça fontionne toujours bien. Le problème c'est lorsque qu'on modifie plusieurs cellule à la fois ou bien qu'on supprime une ligne (sélection multiple donc), j'ai une erreur "incompatibilité de type" sur la ligne 3.

Est-ce bien compliqué à gérer?

Merci

 

[tantal_fr]

Bonjour,


Ça fontionne toujours bien. Le problème c'est lorsque qu'on modifie plusieurs cellule à la fois ou bien qu'on supprime une ligne (sélection multiple donc), j'ai une erreur "incompatibilité de type" sur la ligne 3.

Est-ce bien compliqué à gérer?

Merci

Bonjour,


C'est par-ce-que plusieurs cellules sont modifiées en même temps et donc ton target est une range de plusieurs cellules.

Il faudrait, par exemple, utiliser une boucle for each

Option Explicit
Const LAST_ROW = 65535

Private Sub Worksheet_Change(ByVal Target As Range)

     Dim cellule As Range
    
    For Each cellule In Target
        If cellule.Value > 0 Then

           cellule.Interior.ColorIndex = cellule.EntireRow.Cells(1).Interior.ColorIndex
        Else: cellule.Interior.ColorIndex = xlNone
        End If
        
        If cellule.End(xlDown).Row >= LAST_ROW Then Exit Sub  'On quitte si dernière cellule
    Next cellule

End Sub

 

[spitchz]

Bonjour,

Super ça fonctionne très bien!! Merci de vos réponse.

Bonne soirée

 

[zeb]

Euh, spa bon, ça mon cher Tantal.

Imagine que la feuille ne contiennent que des données sur la ligne 1 et que Target soient "A1:B1".

Que fait faire ta ligne

If cellule.End(xlDown).Row >= LAST_ROW Then Exit Sub

dès la première cellule ?
Un bug !

------------------------

Pis 65536 lignes, c'est une limite 16Bits (!) Les dernières versions d'Excel acceptent plus de lignes et plus de colonnes.
Donc

LAST_ROW = Rows.Count

 

[tantal_fr]

Euh, spa bon, ça mon cher Tantal.

Imagine que la feuille ne contiennent que des données sur la ligne 1 et que Target soient "A1:B1".

Que fait faire ta ligne

If cellule.End(xlDown).Row >= LAST_ROW Then Exit Sub

dès la première cellule ?
Un bug !

Ah oui, au temps pour moi
Ce truc ne marche que si l'on ne travaille qu'avec une colonne.
Faut tester les colonnes aussi :

If cellule.End(xlDown).Row >= Rows.Count And cellule.End(xlToRight).Column >= Columns.Count Then Exit Sub

 

[zeb]

Toujours pas d'accord.
Applique ton algo à ce tableau :
[fixed]
| A B C
--+------
1 | T A N
2 | T A L
3 | F R
[/fixed]
(Observe que la cellule C3 est vide )

[:aha] [:marsien]

 

[tantal_fr]

Oui, effectivement, ça ne marche pas

 

[zeb]

Abus d'optimisation.

 

[tantal_fr]

En effet, c'est une optimisation par approximation statistique t1cable:

Une idée serais d'utiliser .SpecialCells(xlLastCell) pour réduire la plage de Target ; le gain peut être assez faible, par contre.

 

[zeb]

J'ai une autre approche : c'est la zone modifiée qui est passée en paramètre dans Target. Donc soit de très nombreuses cellules sont modifiées et il va falloir toutes les vérifier, soit ce ne sont que quelques une et Target n'en contiendra que très peu.

Donc je me demande bien pourquoi chercher à optimiser ce truc !
:spamafote:

Mais bien sûr, ce raisonnement ne s'applique qu'à ce cas particulier.

En règle générale, vouloir à tout prix sortir le plus vite possible d'une boucle infinie ou presque est très honorable

 

[tantal_fr]

Ben, en fait, j'avais rajouté ça car lorsque l'on fait un copier/coller d'une colonne complète, ça boucle jusqu'en bas, même si les cellules sont vide et qu'il n'y a donc rien à faire.

 

[zeb]

C'est tout à fait légitime, et si je me suis penché sur ta proposition, c'est parce que je lui trouvais un intérêt certain. Mais hélas, on entre dans une telle complication !

 

[tantal_fr]

MS s'est arrêté à mi-chemin. Il faudrais un truc du genre

 SpecialCells(xlCellType[b]Not[/b]Blanks)

 

[zeb]

>> MS s'est arrêté à mi-chemin.
Tu prêches un converti.