XL 2016 couleur texte et soustraction

[jcpat]

Bonjour,
un truc simple à trouver pour les experts mais pour moi c'est plus dur malgré plusieurs test de formule :-(
voilà j'ai une grille , dedans j'ai des prenoms et je fait le calcul, pour mon exemple cela fait 5.
Je cherche à soustraire une cellule si celle ci passe en rouge du coup cela me ferais 5-1 = 4 .

Est ce possible ?

Merci @ vous les experts

 

[soan]

Bonjour jcpat,

1) en B10, il y a 5

2) la cellule active est B4 ; met "pierre" en rouge, et appuie sur la touche F9 ➯ en B10 : 4

3) en B6, met "lysa" en rouge, et appuie sur F9 ➯ en B10 : 3

4) en B7, met "julie" en rouge, et appuie sur F9 ➯ en B10 : 2

5) sélectionne B3:B7, choisis la couleur de texte automatique (noir), et appuie sur F9 ➯ en B10 : y'a de nouveau 5.

6) si au lieu de l'étape 5) tu remets un prénom en noir un par un, en appuyant sur F9 après chaque changement : la valeur affichée en B10 augmente de 1.

voici la mauvaise nouvelle : tu es obligé d'appuyer sur la touche F9 après chaque changement de couleur car un changement de couleur n'est pas un événement détectable par Excel.

j'ai créé la fonction personnalisée NPR() qui compte le nombre de prénoms rouges dans B3:B7.

formule en B10 : =5-NPR()
​

Function NPR() As Byte
  Application.Volatile
  Dim n&, i&
  For i = 3 To 7
    If Cells(i, 2).Font.Color = vbRed Then n = n + 1
  Next i
  NPR = n
End Function

soan

 

[jcpat]

Merci Soan pour cette solution très détaillée,
je vais l'adapter pour mon fichier sur lequel je travail

dés que c'est fait je fait un retour de réalisation .

Merci encore

 

[jcpat]

désolé je reviens vers toi, comment faire pour déterminer l'emplacement de mon cadre , par exemple pour mon fichier je cherche à calculer ce qui se trouve dans les cellules de AL32 à AL50.
Une autre question je vois que tu as écrit la VBA dans le module 1 est ce pareil si je la copie dans ma feuille VBA qui s'appel lundi (en sachant que j'ai deja des lignes de commandes dedans avec SUB....)

Merci Soan

 

[soan]

pour ta 1ère question :

Function NPR() As Byte
  Application.Volatile
  Dim n&, i&
  For i = 32 To 50
    If Cells(i, "AL").Font.Color = vbRed Then n = n + 1
  Next i
  NPR = n
End Function

n'oublie pas d'adapter le 5 de la formule =5-NPR()

---

pour ta 2ème question :

difficile de te répondre sans voir ton fichier et le code VBA déjà présent dans le module de ta feuille "lundi" ; mais je te laisse faire l'essai : si ça marche, alors c'est parfait ! ​

soan

 

[jcpat]

pour ta 1ère question :

Function NPR() As Byte
  Application.Volatile
  Dim n&, i&
  For i = 32 To 50
    If Cells(i, "AL").Font.Color = vbRed Then n = n + 1
  Next i
  NPR = n
End Function

n'oublie pas d'adapter le 5 de la formule =5-NPR()

---

pour ta 2ème question :

difficile de te répondre sans voir ton fichier et le code VBA déjà présent dans le module de ta feuille "lundi" ; mais je te laisse faire l'essai : si ça marche, alors c'est parfait ! ​

soan

j'avais trouver pour le 32 - 50 mais pas le "AL" comme quoi un expert reste un expert ;-)

allez je teste tout cela
merciiiiiii

 

[soan]

comme la colonne AL est la colonne n° 38, on peut aussi mettre :

If Cells(i, 38).Font.Color = vbRed Then n = n + 1

mais c'est quand même plus clair avec Cells(i, "AL")

soan

 

[jcpat]

Oooohhhh j'ai testé dans mon fichier cela marche c'est top mais ... oui il y a un mais :-(
j'ai une MFC qui me passe mes cellules en rouge automatiquement .. la loose
du coup la formule ne tiens pas compte du passage et ne comptabilise pas la couleur.

Dans le fichier j'ai mis eric en B3 qui lui reste figé et une case en E1 ou j'ecris si j'ecris eric du le eric B3 passe en rouge ... et F9 ne marche plus

triste

 

[soan]

@jcpat

dans ce cas, une autre méthode est plus adaptée ; j'ai supprimé Module1, la fonction NPR() n'existe plus ; à la place, voici le code VBA du module de "Feuil1" :​

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address = "$E$1" Then [B6] = -([B3] = .Value)
  End With
End Sub

pour le mode d'emploi, toutes les infos nécessaires sont sur la feuille de calcul. ​

soan

 

[jcpat]

Bonjour Soan,
après une bonne nuit de sommeil je vois ta réponse .. au top ..
Du coup une autre question si je veux faire le calcul sur une grille je change la valeur en B3 ..mais comment prendre en compte la zone pour mon exemple H19 à L26

merci

Normalement après ça j'aurais plus de question

 

[soan]

Bonjour jcpat,

ton fichier en retour.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim chn$, n&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address <> "$B$3" Then Exit Sub
    chn = .Value
    If chn = "" Then [B5] = "": Exit Sub
  End With
  n = Application.CountIf([H19:L26], chn)
  If n = 0 Then [B5] = "" Else [B5] = n
End Sub

---

edit : mon code VBA n'est plus nécessaire : une simple formule Excel suffit ! voir ICI.

soan

 

[jcpat]

Tu es au top merci bcp pour ta patience et tes réponses efficaces.

Je clôture

 

[mapomme]

Bonjour @soan ,

Il me semblerait aussi utile de recompter si une valeur de la plage de comptage est modifiée et cela même si B3 est constant, non ?

nota: je dis peut-être une bêtise car je n'ai pas lu le fil avec grand soin...

 

[jcpat]

Bonjour Mapomme,
Non non pas de bêtises, mais pour ma part la plage de comptage n'est pas modifiable du coup la solution de Soan me convient

@bientôt

 

[soan]

Bonsoir jcpat, mapomme,

j'ai été bête : comme c'est plus la peine de tester la couleur rouge, et que c'est selon les valeurs, un code VBA est inutile, d'où le fichier .xlsx joint, avec cette formule en B5 :

=SI(B3="";"";NB.SI(H19:L26;B3))

cette fois, mapomme, ça tiendra compte d'un changement de valeur en H19:L26 en plus d'un changement en B3, même si c'est pas nécessaire pour cet exo puisque jcpat a indiqué que la plage H19:L26 est fixe. ​

@jcpat : même si j'ai noté ci-dessus la formule, merci de télécharger mon fichier pour faire les mêmes tests qu'avant.

soan