XL 2019 rouge et vert addition et soustraction

Yann71 · 10 Novembre 2020

Bonjour la com, je ne sais si il est possible de répondre à ma recherche. Je souhaite que lorsque j'écrit dans une cellule un nombre en vert, que celle-ci s'additionne à un résultat et que si j'écrit un chiffre en rouge que celui-ci se soustrait au résultat et ceci sans devoir inscrire dans la cellule ce symbole + ou -.
Exemple:
A10= le résultat
A9=10 en vert donc A10=20
A8=5 en rouge donc A10=15
etc...
Autre précision, toutes les cellules de A1 à A9 peuvent être écrit soit en vert ou en rouge.

Merci pour votre aide

sylvanu · 10 Novembre 2020

Bonjour Yann,
Etrange comme requête.
En PJ un essai avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A9")) Is Nothing Then
        Vert = [F1].Font.Color: Rouge = [G1].Font.Color
        Somme = 0
        For L = 1 To 9
            If Cells(L, "A").Font.Color = Rouge Then
                Somme = Somme - Cells(L, "A")
            ElseIf Cells(L, "A").Font.Color = Vert Then
                Somme = Somme + Cells(L, "A")
            End If
        Next L
        [A10] = Somme
    End If
End Sub

Les couleurs choisies sont à mettre en F1 G1 car Rouge et Vert ne signifient pas grand chose.
Il en existe des centaines. Sauf évidemment RGB(255,0,0) et RGB(0,255,0) mais le 'vrai" vert est rarement dans la palette. Aussi ces deux cellules serviront de référence de couleurs.

Yann71 · 10 Novembre 2020

sylvanu à dit:
Bonjour Yann,
Etrange comme requête.
En PJ un essai avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:A9")) Is Nothing Then Vert = [F1].Font.Color: Rouge = [G1].Font.Color Somme = 0 For L = 1 To 9 If Cells(L, "A").Font.Color = Rouge Then Somme = Somme - Cells(L, "A") ElseIf Cells(L, "A").Font.Color = Vert Then Somme = Somme + Cells(L, "A") End If Next L [A10] = Somme End If End Sub

Les couleurs choisies sont à mettre en F1 G1 car Rouge et Vert ne signifient pas grand chose.
Il en existe des centaines. Sauf évidemment RGB(255,0,0) et RGB(0,255,0) mais le 'vrai" vert est rarement dans la palette. Aussi ces deux cellules serviront de référence de couleurs.

Bonjour Sylvanu, comment vas-tu ?
Je te remercie pour ton intervention si rapide. Je confirme que cette requête est bizarre, mais elle reflète le personnage qui me la demandé, et pour moi je te l'avoue que ça me permet aussi d'apprendre les choses qui sont bizarre. Je m'aperçois que j'ai omis de précisé un détail important, celui de dire que ce ne sont pas des nombres mais des heures. Je suis sincèrement dsl de ce manque de précision. Une chose encore est-ce possible aussi que le total s'affiche en rouge ou en vert sans afficher les symboles + -

sylvanu · 10 Novembre 2020

Avec un petit test supplémentaire.
A noter la mise en forme : [h]:mm qui permet des valeurs > 24:00.

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A9")) Is Nothing Then
        Vert = [F1].Font.Color: Rouge = [G1].Font.Color
        Somme = 0
        For L = 1 To 9
            If Cells(L, "A").Font.Color = Rouge Then
                Somme = Somme - Cells(L, "A")
            ElseIf Cells(L, "A").Font.Color = Vert Then
                Somme = Somme + Cells(L, "A")
            End If
        Next L
        [A10] = Abs(Somme)
        If Somme >= 0 Then
            [A10].Font.Color = Vert
        Else
            [A10].Font.Color = Rouge
        End If
    End If
End Sub

Yann71 · 10 Novembre 2020

sylvanu à dit:

Avec un petit test supplémentaire.
A noter la mise en forme : [h]:mm qui permet des valeurs > 24:00.

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A9")) Is Nothing Then
        Vert = [F1].Font.Color: Rouge = [G1].Font.Color
        Somme = 0
        For L = 1 To 9
            If Cells(L, "A").Font.Color = Rouge Then
                Somme = Somme - Cells(L, "A")
            ElseIf Cells(L, "A").Font.Color = Vert Then
                Somme = Somme + Cells(L, "A")
            End If
        Next L
        [A10] = Abs(Somme)
        If Somme >= 0 Then
            [A10].Font.Color = Vert
        Else
            [A10].Font.Color = Rouge
        End If
    End If
End Sub

Sylvanu, je ne peux que te remercier. Tu es génial, toujours aussi réactif, tes connaissances sont on ne peut que qu'appréciable. Je te souhaite une bonne journée malgré la situation dans laquelle nous vivons. " ça va aller "

Yann71 · 12 Novembre 2020

Yann71 à dit:
Sylvanu, je ne peux que te remercier. Tu es génial, toujours aussi réactif, tes connaissances sont on ne peut que qu'appréciable. Je te souhaite une bonne journée malgré la situation dans laquelle nous vivons. " ça va aller "

Bonjour Sylvanu, je reviens car j'ai un problème. Lorsque dans ton fichier je rentre une heure en vert ou rouge, pour que l'addition ou soustraction se fasse, il faut sélectionner une cellule dans la colonne d'entrée. Est-ce qu'il y a une solution pour que cela effectue le calcul sans devoir passer par cette manip.

sylvanu · 12 Novembre 2020

Bonjour Yann,
Dois je comprendre que cette valeur n'est pas entrée dans la bonne colonne mais est issue d'un calcul ?
Comme par ex en A3 on aurait : =B6 ?
Dans ce cas effectivement ça ne marche pas car il faut valider par entrée pour lancer la macro.
Ce que je ne comprends pas, c'est comment vous fixer la couleur de la cellule sans y être ?
Vous auriez un petit fichier test ?

fanch55 · 12 Novembre 2020

salut le fil, @sylvanu ,
Il serait peut-être préférable d'utiliser l'événement change ....

Yann71 · 12 Novembre 2020

sylvanu à dit:
Bonjour Yann,
Dois je comprendre que cette valeur n'est pas entrée dans la bonne colonne mais est issue d'un calcul ?
Comme par ex en A3 on aurait : =B6 ?
Dans ce cas effectivement ça ne marche pas car il faut valider par entrée pour lancer la macro.
Ce que je ne comprends pas, c'est comment vous fixer la couleur de la cellule sans y être ?
Vous auriez un petit fichier test ?

sylvanu · 12 Novembre 2020

??? Mais encore ?

Yann71 · 12 Novembre 2020

La valeur est entrée dans la colonne par une addition ou soustraction de plusieurs autres cellule exemple X1=(W1:W4). Donc est-ce que la macro peut se lancé automatiquement sans passer par ENTER

sylvanu · 12 Novembre 2020

Ca veut dire que la couleur est faite par MFC ?

Si c'est le cas c'est beaucoup plus complexe car vu du VBA une couleur par MFC n'est pas une couleur accessible simplement par font.color.
Dans ce cas, le plus simple est d'utiliser les cellules qui sont à l'origine des calculs.
Car dans l'état actuel seul un Enter lance la macro.
Donnez un fichier test représentatif ( sans données sensibles ).

Yann71 · 12 Novembre 2020

voici le fichier que j'utilise, la macro dois être appliquée à la colonne "X"

sylvanu · 12 Novembre 2020

Tout ça pour ça.
Mettre la colonne X en format :

VB:

[h]"h"mm;[h]"h"mm

Le signe "moins" disparait, mais comme la valeur est conservée la MFC remplit son office.
Et la macro ne sert plus à rien.

Yann71 · 12 Novembre 2020

sylvanu à dit:
Tout ça pour ça.
Mettre la colonne X en format :

VB:

[h]"h"mm;[h]"h"mm

Le signe "moins" disparait, mais comme la valeur est conservée la MFC remplit son office.
Et la macro ne sert plus à rien.

Je pense que si j'aurai mis un fichier original l'aide aurait été ciblée à l'essentiel. Par contre lorsque le total doit devenir vert il n'inscrit pas le total mais "FAUX" sur le fichier que tu m'as fait parvenir.

XL 2019 rouge et vert addition et soustraction

Yann71

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

Yann71

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

Yann71

XLDnaute Occasionnel

Yann71

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Yann71

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Yann71

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Yann71

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Yann71

XLDnaute Occasionnel

Discussions similaires