Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 couleur texte et soustraction

jcpat

XLDnaute Occasionnel
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
 

Pièces jointes

  • couleurtexte-soustraction.xlsx
    8.5 KB · Affichages: 24
Solution
Bonjour jcpat,

ton fichier en retour.

VB:
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

soan

XLDnaute Barbatruc
Inactif
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()
VB:
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
 

Pièces jointes

  • couleurtexte-soustraction.xlsm
    14.9 KB · Affichages: 5
Dernière édition:

jcpat

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Inactif
pour ta 1ère question :

VB:
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Inactif
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • couleurtexte-soustraction avec MFC.xlsm
    15 KB · Affichages: 5

soan

XLDnaute Barbatruc
Inactif
@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" :​

VB:
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
 

Pièces jointes

  • couleurtexte-soustraction avec MFC.xlsm
    14.6 KB · Affichages: 5

jcpat

XLDnaute Occasionnel
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
 

Pièces jointes

  • couleurtexte-soustraction avec MFC (2).xlsm
    15.9 KB · Affichages: 3

soan

XLDnaute Barbatruc
Inactif
Bonjour jcpat,

ton fichier en retour.

VB:
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
 

Pièces jointes

  • couleurtexte-soustraction avec MFC (2).xlsm
    15.5 KB · Affichages: 6
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
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
 

Pièces jointes

  • couleurtexte-soustraction avec MFC (2).xlsx
    10 KB · Affichages: 3

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…