La mise en forme conditionnelle

Accueil

 

Mise en forme conditionnelle simple
Dates supérieures date jour
Week-End
JoursFeries
Les n derniers mois
Coloriage planning projet
Maximum
Sous-Totaux
Surligner les lignes qui contiennent un mot
Surligner les cellules qui contiennent un mot cherché
Appartenance à une liste
Surligner les doublons
Doublons 2 critères
Non concordance
Non concordance 2 critères
Mots appartenant à une liste
Mots appartenant à une liste2

Mots appartenant à une liste3
Rupture
AlerteDate
Calendrier annuel
Appartenance à un ensemble de dates
Recouvrement de dates/heures
Nos de série de billets
Colorier jusqu'au dernier mois saisi
Comparaison 2BD
Comparaison de 2 champs sur onglets différents
Comparaison de 2 champs sur onglets différents 2
Colorier 1 ligne sur 2
Colorier 4 lignes sur 8
Colorier 1 groupe sur 2
Curseur en couleur
Quadrillage
Feux avec police wingdings
Jauge MFC
Coloriage ligne/colonne
Affichage planning en fonction d'un choix
Anniversaire
Comparaison des champs de 2BD
Comparaison de champs sur 2 feuilles
Caracteres invalides
Plus de 3 conditions
MFC sur zone calculée
MFC image
MFC sur commentaire
MFC par affichage d'un commentaire
Jauge avec shape
MFCpar modification de la transparence de shapes
Fonction d'affichage d'une image d'arrière-plan sur un champ
Construction de feux tricolores
Comparaison de 2 BD
MFC sur la couleur
MFC avec police wingdings
Coloriage d'une image en fonction d'une valeur
Coloriage d'une image avec la couleur d'une cellule
Compte les cellules ayant une couleur MFC
Repérage de doublons 3D


La mise en forme conditionnelle complète la commande Format/Cellule/Nombre.

Mise en forme conditionnelle simple

Modifier la mise en forme des nombres compris entre 2 valeurs

On veut mettre en gras et fond bleu les nombres compris entre 100 et 200

-Selectionner B3:B9
-Format/Mise en forme conditionnelle
-La valeur de la cellule est comprise entre 100 et 200
-Cliquer sur le bouton Format et choisir la mise en forme.

Colorier les cellules contenant une chaîne de caractères particulière

On veut colorier en jaune les cellules contenant la lettre C.

  • Sélectionner le champ à colorier
  • Format/Mise en forme conditionnelle

Colorier les lignes pour lesquelles la date est supérieure à la date du jour

-Sélectionner le champ
-Format/mise en forme conditionnelle
-La formule est: =$C2>AUJOURDHUI()

Colorier les week-end

Pour faire apparaître en couleur les Samedi et Dimanche:

-Sélectionner le champ A1:A30
-Format/Mise en forme conditionnelle
-Choisir La formule est
-=OU(JOURSEM(A1)=1;JOURSEM(A1)=7)

ou

=JOURSEM(A1;2)>5

Jours fériés

-Sélectionner B5:BF13
-Format/Mise en forme conditionnelle
-La formule est:
=NB.SI(Fériés;A$5)=1

Les n derniers mois par rapport à la date du jour

-Sélectionner A2:B31
-Format/Mise en forme/Conditionnelle
-Choisir La formule est:

=ET($A2>=DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI())-$D$2;JOUR(AUJOURDHUI())); ($A2<=DATE(ANNEE(AUJOURDHUI());MOIS(AUJOURDHUI());JOUR(AUJOURDHUI()))))

Coloriage d'un planning projet entre 2 dates

On veut colorier un planning projet entre la date de début et la date de fin.
MFC en A5: =ET(A5>=Debut;A5<=Fin;JOURSEM(A5;2)<6)

PlanningProjet
PlanningProjet2

Coloriage du premier vendredi de chaque mois

MFC en A2 =(A$2-JOURSEM(A$2-6)+7)=A2

Surligner le maximum

-Sélectionner le champ A2:B8
-Format/Mise en forme conditionnelle
-Choisir La Formule est
=$B2=MAX($B$2:$B$8)

Colorier les lignes des sous-totaux:

  • Trier par Service
  • Données/Sous_total
  • Choisir : A chaque changement de Service
  • Cocher Salaire
  • Choisir Moyenne

     Format conditionnel

  • Sélectionner le champ A2:E30
  • -Format/Mise en forme conditionnelle
  • -Choisir La formule est: =GAUCHE($B2;7)="Moyenne"

Créer des sous-totaux à 2 niveaux

Format conditionnel:

-Sélectionner le champ A1:E30
-Format/Mise en forme conditionnelle

=ET(GAUCHE($B2;7)="Moyenne")

-Sélectionner D2:E30
-Format/Mise en forme conditionnelle
-Ajouter
=ET(GAUCHE($D2;7)="Moyenne")

Surligner les doublons

-Sélectionner A2:A11
-Format/Mise en forme conditionnelle
-Choisir la formule Est:
=NB.SI($A$2:$A$11;A2)>1

Doublons avec plusieurs noms par cellule

DoublonsCellules


MFC: =doublons(A2;$A$2:$A$7)

Function doublons(nom As Range, noms As Range)
 Application.Volatile
 a = Split(nom, " ")
 For Each k In a
   If Application.CountIf(noms, "*" & Trim(k) & "*") > 1 Then doublons = True
 Next k
End Function

Doublons 2 critères

-Sélectionner A23:B11
-Format/Mise en forme conditionnelle
-Choisir la formule est:
=SOMMEPROD(($A$2:$A$11=$A2)*($B$2:$B$11=$B2))>1

Autre exemple

On veut barrer en colonne A et B les travaux effectués (colonnes E:F)

-Sélectionner A1:B15
-Format/Mise en forme conditionnelle/formule
=SOMMEPROD(($E$1:$E$8=$A1)*($F$1:$F$8=$B1))>0

Doublons dans l'intérieur des cellules

-Sélectionner A1:A10
-Format/MFC
=doublons(A1;$A$1:$A$10)>1

DoublonsIntérieurCellule

Function doublons(a As Range, b As Range)
  temp = Split(a, " ")
  temp2 = b
  n = 0
  For i = LBound(temp) To UBound(temp)
    For j = LBound(temp2) To UBound(temp2)
      If Not IsError(Application.Match(temp(i), Split(temp2(j, 1), " "), 0)) Then n = n + 1
    Next j
  Next i
  doublons = n - UBound(temp)
End Function

Non concordance

Colorie les noms de liste1 qui n'existent pas dans liste2

-Format/Mise en forme conditionnelle
-La formule est
=ESTNA(EQUIV(A2;$C$2:$C$8;0))
ou
=NB.SI($C$2:$C$8;A2)=0

Comparaison de 2 listes de prix

On compare 2 listes de prix dans les colonnes A:B de de 2 feuilles BD1 et BD2

Compare_Prix

Noms de champ
Base1 ='BD1'!$A$2:$B$60
Base2 ='BD2'!$A$2:$B$58

Le produit existe t-il?:    =ESTERREUR(RECHERCHEV($A2;Base2;1;FAUX)) ou =ESTERREUR(EQUIV($A2;INDEX(Base2;;1);0))
Le prix est-il différent?:  =RECHERCHEV($A2;Base2;2;FAUX)<>$B2

Non concordance 2 critères

On cherche dans le champ A2:B9 les lignes pour lesquelles le couple code postal/ville n'existe pas
dans le tableau H2:I7

-Sélectionner A2:B9
-Format/Mise en Forme conditionnelle/Formule
=SOMMEPROD((CodePostal=$A2)*(Ville=$B2))=0

Noms de champ
CodePostal $E$2:$E$7
Ville $F$2:$F$7

Surligner les lignes qui contiennent un mot

Surligne les lignes qui contiennent le service de I2
-Selectionner le champ A2:F14
-Format/Mise en forme conditionnel
-Choisir La formule est:

=$F1=$I$2

Surligner les cellules qui contiennent un mot cherché dans une cellule

-Selectionner le champ A2:A30
-Format/Mise en forme conditionnel
-Choisir La formule est:

=CHERCHE($C$2;A2)

ou

=NB.SI(A2;"*"&$C$2&"*")

Surligne les noms appartenant à une liste

-Format/Mise en forme conditionnelle
-La formule est
=NB.SI($D$2:$D$6;A2)>0
ou
=NB.SI($D$2:$D$6;A2)>0

On colorie les dates qui ne contiennent pas de mois.

=NON(ESTNUM(EQUIV(1;NB.SI(A1;"*"&TEXTE(DATE(;LIGNE(1:12);1);"mmmm")&"*");0)))

Dans le champ G3:G8, on veut colorier les mots qui apparaissent dans B3:E12

-Sélectionner G3:G8
-Format/Mise en forme conditionnelle/La formule est
=NB.SI($B$3:$E$12;G3)>0

On veut colorier les mots qui apparaissent dans B3:E12

La couleur dépend de la classe (1,2,3)

-Sélectionner B3:E12
-Format/Mise en forme conditionnelle/La formule est
=INDEX(Classe;EQUIV(B3;Mots;0))=1

On colorie si un des noms de la cellule appartient à la liste

-Format/MFC/La formule est
=SOMMEPROD(ESTNUM(CHERCHE(Liste;A1))*1)>0

Autre exemple

On colorie les lignes dont les titres contiennent un des mots clés de la liste en C2:C5 ET pour lesquelles
l'année est égale à A2.

=(SOMMEPROD(ESTNUM(CHERCHE(Liste;$C10))*(Liste<>""))>0)*(SI($A$2>0;$B10=$A$2;VRAI))

MFCInclus

Rupture

La base est triée par services
On fait apparaître des pointillés à chaque changement de service

- Sélectionner A2:F100
- Format/mise en forme cond
- Choisir La formule est
- =$F1<>$F2

Autre version

1 - Sélectionner E2:F100
2 - Format/mise en forme cond
3- Choisir La formule est
4 - =ET($E1<>$E2;$G$2="oui")

Masquer les doublons

On masque les doublons en colonne A et B

-Sélectionner A2:C9
-MFC/La formule est
-=($E$2="non")*(A1=A2)

MFCRupture

On veut colorier la cellule A1 si elle contient au moins un chiffre (A2G9L e.g.)

MFC=SOMMEPROD(--(ESTNUM(--(STXT(A1;LIGNE($1:$255);1)))))

Alerte date

On veut des alertes 10,15,20 jours avant la date du jour.

-Sélectionner A2:D27
-Format/Mise en forme conditionnelle/La formule est
=AUJOURDHUI()>=$B2-10
=AUJOURDHUI()>=$B2-15
=AUJOURDHUI()>=$B2-20

Anniversaire

Surligne 1 semaine avant l'anniversaire jusqu'à l'anniversire.

=ET(DATE(ANNEE(AUJOURDHUI());MOIS($B2);JOUR($B2))-AUJOURDHUI()<=7;DATE(ANNEE(AUJOURDHUI());MOIS($B2);JOUR($B2))>=AUJOURDHUI())

Calendrier annuel

-Sélectionner le calendrier
-Format/Mise en forme cond/La formule est
=JOURSEM(A5;2)>5
=NB.SI(fériés;A5)>0

-La valeur de la cellule est égale
=AUJOURDHUI()

Pour créer le calendrier:

-Sélectionner A5:L35
=SI(MOIS(DATE(an;COLONNE(1:12);LIGNE(1:31)))=COLONNE(1:12);DATE(an;COLONNE(1:12);LIGNE(1:31));"")
Valider avec Maj+Ctrl+entrée

Appartenance à un ensemble de dates

On veut colorier les dates qui appartiennent à un ensemble de dates définies en C2:D6.

MFC en F4:=SOMMEPROD((F4>=début)*(F4<=Fin))>0

MFCDates

Vacances scolaires

Vacances

Recouvrement de dates/heures

Un véhicule ne doit pas être affecté 2 fois au même moment.

MFCDatesIntersect

=(SOMMEPROD(($A2>=début)*($A2<=fin)*($C2=véhic))>1)*($A2<>"")
=(SOMMEPROD(($B2>=début)*($B2<=fin)*($C2=véhic))>1)*($A2<>"")
=(SOMMEPROD(($A2<=début)*($B2>=fin)*($C2=véhic))>1)*($A2<>"")

MFC Planning

Pour obtenir un planning:

-Sélectionner E3:AI7
-Format/MFC/La formule est: =ET(E$2>=$B3;E$2<=$C3)

Autre exemple

Format/MFC/La formule est:
=SOMMEPROD((Noms=$A3)*(B$2>=Début)*(B$2<=Fin))

PlanningBD

Autre exemple

MFC en C4: =SOMMEPROD((B5>=Début)*(B5<=Fin)*(Noms=C$4)*(Etat="Accepte"))

CalendrierBDMFC

Numéros de série de billets

On colorie et on barre si tous les nos de série de billets on étés vendus.
Les billets sont dans la colonne A dans le désordre.

-Sélectionner E2:G3
-Format/mise en forme cond/La formule est

=ESTNA(EQUIV(VRAI;ESTNA(EQUIV(LIGNE(INDIRECT(MOD(E$1;10000)&":"&MOD(E$2;10000)))
+ENT(E1/10000)*10000;$A$2:$A$999;0));0))

Colorier jusqu'au dernier mois saisi

MFC:
-Sélectionner A2:M9
-Format/Mise en forme conditionnelle/Formule
=COLONNE(A1)<=MAX(SI($A$2:$M$9<>"";COLONNE($A$2:$M$9);0))

Impression dynamique des mois saisis
-Insertion/Nom/Définir
-Champ
=DECALER($A$1;;;9;MAX(SI($A$2:$M$9<>"";COLONNE($A$2:$M$9);0)))

Comparaison 2 BD sur 2 critères

On veut repérer dans BD2 les lignes qui existent déjà dans BD1

-Sélectionner A2:B11
-Format/Mise en Formecond/La formule est

=SOMMEPROD((Nom=$A2)*(Prenom=$B2)*(Nom<>""))>0

Noms de champ dans BD1
Nom =$A$2:$A$10
Prenom =$B$2:$B$10

On veut repérer dans BD2 les lignes qui n'existent pas dans BD1

-Sélectionner A2:B11
-Format/Mise en Formecond/La formule est

=SOMMEPROD((Nom=$A2)*(Prenom=$B2))=0

Comparaison 2 champs sur des onglets différents

Les formats conditionnels n'acceptent pas de références à d'autres feuilles. On contourne
le problème en utilisant des noms de champs.

On veut comparer le Ca réalisé au ca prévu(sur un autre onglet):

-Dans l'onglet Prévu , nommer CaPrévu la cellule B3 en relatif:
   .Cliquer sur B3
   .Insertion/Nom/définir CaPrévu
   .Remplacer $B$3 par B3.
-Sélectionner B3:F13 de Réalisé
-Format/Mise en forme conditionnelle/formule
=B3<CaPrévu

Compare 2 champs

Comparaison de 2 champs sur 2 feuilles différentes 2

Si les champs ne sont pas disposés au même endroit

Compare 2 champs

Noms de champ
champ1 =Feuil1!$A$1:$C$12
champ2 =Feuil2!$B$5:$D$16

-Sélectionner A1:C12
-Format/MFC/Formule =A1<>INDEX(champ2;LIGNE();COLONNE())

Colorier une ligne sur 2

-Selectionner le champ A2:E100
-Format/Mise en forme conditionnelle
-Choisir La formule est:
=MOD(LIGNE();2)=0

Colorier 4 lignes sur 8

-Selectionner le champ A2:E100
-Format/Mise en forme conditionnelle
-Choisir La formule est:
=MOD(ENT((LIGNE()+2)/4);2)<>0

Colorier un groupe sur 2

Selectionner le champ A2:F17
-Format/Mise en forme conditionnelle
-Choisir La formule est:
=MOD(ENT(SOMME(1/NB.SI($F$2:$F2;$F$2:$F2)));2)=1

Lorsque le nombre de lignes devient important, la MFC ralentit l'exécution. On peut colorier par VBA.

Sub coloriage()
  Application.ScreenUpdating = False
  [A1].CurrentRegion.Sort Key1:=[A2], Order1:=xlAscending, Header:=xlGuess ' tri
  couleur = 36
  For i = 2 To [A65000].End(xlUp).Row
     If Cells(i, 1) <> Cells(i - 1, 1) Then couleur = IIf(couleur = 36, 34, 36)
     Cells(i, 1).Resize(, 2).Interior.ColorIndex = couleur
  Next i
  Application.ScreenUpdating = True
End Sub

Curseur en couleur

Coloriage cellule active pour un champ seulement.

-Selectionner A2:D100
-Format/Mise en forme conditionnelle/La formule est
=ET(LIGNE()=CELLULE("ligne");COLONNE()=CELLULE("colonne"))

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Calculate
End Sub

Pour surligner la ligne du champ A2:D16

-Sélectionner le champ A2:D16
-Format/Mise en forme Conditionnelle
=LIGNE()=CELLULE("ligne")

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

Autre version

-Selectionner A2:D100
-Format/Mise en forme conditionnelle/La formule est
=ET(LIGNE()=CELLULE("ligne");COLONNE()<=CELLULE("colonne"))
=ET(COLONNE()=CELLULE("colonne");LIGNE()<=CELLULE("ligne"))

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Calculate
End Sub

Quadrillage

Le quadrillage n'apparaît qu'au fur et à mesure de la saisie dans la colonne A.

-Sélectionner A2:D100
-Format/Mise en forme conditionnelle
-Choisir La formule est:
=$A2<>""
-Dans Format, choisir un fond et un quadrillage

Autre version

Le quadrillage n'apparaît qu'au fur et à mesure de la saisie dans la colonne A,B,...
Il peut y avoir plusieurs lignes vides

-Sélectionner A2:D30
-Format/Mise en forme conditionnelle
-Choisir La formule est:

=LIGNE(A2)<=MAX(SI($A$2:$D$30<>"";LIGNE($A$2:$D$30);0))

-Dans Format, choisir un fond et un quadrillage

Feux avec police wingdings

Utiliser la police WingDings2

-Colorier en rouge la colonne D
-Sélectionner la colonne D
-Format/MFC/Condition1/La formule est
=C2/B2>80% Vert
-Format/MFC/Condition2/La formule est =C2/B2>60% Orange

MFCFeux

Jauge MFC

Par rapport au mois en cours (mars sur l'exemple), on voit l'avance/retard du réalisé sur l'objectif.

-Sélectionner B4:F9
-Format/MFC/la formule est :=B$10>(B$2/6)*(LIGNES(B$1:B1)-0,5)

JaugeMFC

Surlignage ligne/Colonne

On veut surligner la ligne et la colonne qui correspondent à la hauteur et à la longueur
choisies en B1 et B2

-Sélectionner A7:L16
-Format/Mise en forme conditionnelle/Formule
=$A7=INDEX(Hauteur;EQUIV($B$1;Hauteur;1))
=A$7=INDEX(longueur;EQUIV($B$2;longueur;1)
)

Comparaison de 2 BD par MFC

Comparaison de 2 bases avec MFC. La clé de comparaison est le nom (colonne A).

BD compare

Contenu différent:

-Sélectionner A2:D20
-Format/Mise en forme conditionnelle/La formule est
=INDEX(MaBD2;EQUIV($A2;INDEX(MaBD2;;1);0);COLONNE())<>A2

Non trouvés dans BD1:

=ET(A2<>"";ESTNA(EQUIV($A2;INDEX(MaBD2;;1);0)))

Noms de champs
MaBD1 ='BD1'!$A$2:$D$100
MaBD2 ='BD2'!$A$2:$D$100

Pas de caractères invalides dans les cellules

On colorie les cellules qui contiennent un caractère invalide.

MfcCaractInvalide

Liste des caractères valides
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz @-_.0123456789

Format/Mise en forme conditionnelle/La formule est
=SOMMEPROD((A1<>"")*(ESTERREUR(CHERCHE(STXT(A1;LIGNE(INDIRECT("1:"&NBCAR(A1)));1);
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz @-_.0123456789"))))

ou

=SOMMEPROD((A1<>"")*(ESTERREUR(CHERCHE(STXT(A1;LIGNE($1:$255);1);
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz @-_.0123456789"))))

Affichage d'un planning en fonction d'un choix

On affiche seulement le planning de la(les) ville(s) choisie(s).

MFC: =NON(ESTNUM(CHERCHE(STXT(B5;CHERCHE(" ";B5)+1;99);$A$3)))

MFCAppartenance

Autre version

MFC: =NON(OU(ESTNUM(CHERCHE(B5;$A$3));ESTNUM(CHERCHE(B6;$A$3))*(B6<>"")))

Autre version

L'opérateur peut choisir 1 ou plusieurs villes en C2:C4.

MFC: =NON(OU(ESTNUM(EQUIV(B7;ChoixVilles;0));ESTNUM(EQUIV(B8;ChoixVilles))*(B8<>"")))

Choix par type de formation

On affiche les stages pour un(des) type(s) de formation choisi(s) en C2:C4.

MFC: =NON(ESTNUM(EQUIV(INDEX(Type;EQUIV(B7;stage;0));ChoixFormation;0)))

Surligner les mots contenant un caractère accentué

=SOMMEPROD(--(ESTNUM(CHERCHE(STXT(A1;LIGNE(INDIRECT("1:"&NBCAR(A1)));1);"éèà"))))

Colorie les cellules présentes dans la formule en D2

MFC:=InclusDans($D$2;A1)

Dans un module

Function InclusDans(formule, c)
  InclusDans = (InStr(formule.Formula, c.Address(RowAbsolute:=False, ColumnAbsolute:=False)) > 0)
End Function

MFC avec police Wingdings

Si le réalisé est >=95%, on veut afficher un cercle vert, si le réalisé est <95%, on veut afficher un cercle rouge

Condition1: =ET(ESTNUM(C2);C2>=95%)
Condition2: =C2<95%
Condition3: =ESTTEXTE(C2)

MFCWingdings

Plus de 3 MFC

Saisie de texte

MFCPlus3cond

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([ChampMFC], Target) Is Nothing Then
    Application.EnableEvents = False
    On Error Resume Next
    [Couleurs].Find(Target, LookAt:=xlWhole).Copy
    Target.PasteSpecial Paste:=xlPasteFormats
    Application.EnableEvents = True
  End If
End Sub

Si plusieurs champs

For Each c In Union([ChampMFC1], [ChampMFC2];..)

La cellule contient un des mots du champ COULEURS

Par exemple xx Mal xx.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([ChampMFC], Target) Is Nothing Then
     Target.Interior.ColorIndex = xlNone
     For Each c In [couleurs]
       If InStr(UCase(Target), UCase(c)) > 0 And c <> "" Then Target.Interior.ColorIndex = c.Interior.ColorIndex
     Next
   End If
End Sub

Coloriage de la ligne

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 3 Then
     On Error Resume Next
     Cells(Target.Row, 1).Resize(, 4).Interior.ColorIndex = [etat].Find(Target, LookAt:=xlWhole).Interior.ColorIndex
  End If
End Sub

ColoriageLigne

Saisie de nombres

Modifie la couleur d'une zone numérique saisie.

MFCZoneNum
MFCZoneNum2

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([ZoneMFC], Target) Is Nothing And Target.Count = 1 Then
    p = Application.Match(Target, Sheets("couleurs").Range("couleursNB"), 1)
    If Not IsError(p) Then
       Target.Interior.ColorIndex = Sheets("couleurs").Range("couleursNB")(p).Interior.ColorIndex
    End If
  End If
End Sub

Modifie le format d'une zone numérique saisie

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([ZoneMFC], Target) Is Nothing And Target.Count = 1 Then
    p = Application.Match(Target, [couleursNB], 1)
    If Not IsError(p) Then
       Sheets("couleurs").Range("couleursNB")(p).Copy
       Application.EnableEvents = False
       Target.PasteSpecial Paste:=xlPasteFormats
       Application.EnableEvents = True
    End If
  End If
End Sub

Avec 2 champs de formats

MFCZoneNum2Zones

MFC sur zone calculée

Modifie le format d'une zone calculée. MFCZoneCalcul

Private Sub Worksheet_Calculate()
  Application.ScreenUpdating = False
  For Each c In [ZoneCalcul]
    p = Application.Match(c.Value, [couleursNB], 1)
    If Not IsError(p) Then
      Sheets("couleurs").Range("couleursNB")(p).Copy
      c.PasteSpecial Paste:=xlPasteFormats
    End If
  Next
  Application.ScreenUpdating = True
End Sub

Couleur de fond seulement

Private Sub Worksheet_Calculate()
   For Each c In [ZoneCalcul]
     p = Application.Match(c.Value, Sheets("couleurs").Range("couleursNB"), 1)
     If Not IsError(p) Then
       c.Interior.ColorIndex = Sheets("couleurs").Range("couleursNB")(p).Interior.ColorIndex
     End If
   Next
End Sub

Si plusieurs champs

For Each c In Union([ZoneCalcul1], [ZoneCalcul2];..)

Coloriage en fonction de l'état d'une tâche

MFCEtatTâche
MFCEtatTâche2

Private Sub Worksheet_Calculate()
  Application.ScreenUpdating = False
  [zoneDate].Offset(, -1).Resize(, 4).Interior.ColorIndex = xlNone
  For Each c In [zoneDate]
    If c > 0 Then
      If Date = c.Value Then _
         c.Offset(, -1).Resize(, 4).Interior.ColorIndex = Range("légende")(2).Interior.ColorIndex
      If Date > c.Value And c.Offset(, 1) <> "ok" Then _
         c.Offset(, -1).Resize(, 4).Interior.ColorIndex = Range("légende")(3).Interior.ColorIndex
      If c.Value >= Date + 1 And c.Value <= Date + 4 Then _
         c.Offset(, -1).Resize(, 4).Interior.ColorIndex = Range("légende")(4).Interior.ColorIndex
      If c.Offset(, 1) = "ok" Then _
         c.Offset(, -1).Resize(, 4).Interior.ColorIndex = Range("légende")(1).Interior.ColorIndex
    End If
  Next c
End Sub

Coloriage en fonction de l'état d'une facture

MFCDateFacture

Private Sub Worksheet_Calculate()
  Application.ScreenUpdating = False
  For Each c In [zoneDate]
    coul = 2
    If c <> "" Then
      If Date > c Then coul = 3
      If Date > c + 30 Then coul = 4
      If Date > c + 60 Then coul = 5
      If c.Offset(, 1) > 0 Then coul = 1
    End If
    c.Offset(, -4).Font.ColorIndex = Range("couleurs")(coul).Interior.ColorIndex
  Next c
End Sub

Autre exemple de MFC sur zone calculée

MFCCalculate2

Autre exemple de MFC sur zone calculée

La couleur dépend de l'avancement des tâches
Si une ou des tâches dépassent la date butoir, alors la case devient striée.

MFCExpression

Priv ate Sub Worksheet_Calculate()
  For lig = 2 To 4 Step 2
    Set c = Cells(lig, 6)
    If c.Value < 0.4 Then
      c.Interior.ColorIndex = 3
      c.Interior.Pattern = xlSolid
    End If
    If Application.Max(c.Offset(, -3).Resize(1, 3).Offset(1)) > c.Offset(, -5).Value And c.Value < 0.4 Then
      c.Interior.ColorIndex = 3
      c.Interior.Pattern = xlUp
      c.Interior.PatternColorIndex = xlAutomatic
     End If
     If c.Value > 0.4 And c.Value < 0.8 Then
       c.Interior.ColorIndex = 8
       c.Interior.Pattern = xlSolid
       c.Interior.PatternColorIndex = xlAutomatic
     End If
     If Application.Max(c.Offset(, -3).Resize(1, 3).Offset(1)) > c.Offset(0, -5).Value And c.Value > 0.4 Then
        c.Interior.ColorIndex = 8
        c.Interior.Pattern = xlUp
        c.Interior.PatternColorIndex = xlAutomatic
     End If
     If c.Value > 0.8 Then
        c.Interior.ColorIndex = 4
        c.Interior.Pattern = xlSolid
     End If
     If Application.Max(c.Offset(, -3).Resize(1, 3).Offset(1)) > c.Offset(0, -5).Value And c.Value > 0.8 Then
         c.Interior.ColorIndex = 4
         c.Interior.Pattern = xlUp
         c.Interior.PatternColorIndex = xlAutomatic
      End If
Next lig
End Sub

MFC avec 2 conditions

MFC2conditions

Autre exemple

Le planning ci dessous est obtenu a l'aide de formules

En A1:
=SI(SOMMEPROD((Noms=$A4)*(B$2>=Début)*(B$2<=Fin))>0;INDEX(Stages;MIN(SI((Noms=$A4)*(B$2>=Début)*(B$2<=Fin);LIGNE(Noms)))-1);"")

PlanPanoramique

Pour colorier les stages:

Private Sub Worksheet_Activate()
  For Each c In [ZonePlan1]
    c.Interior.ColorIndex = xlNone
    On Error Resume Next
    c.Interior.ColorIndex = [couleurs].Find(c, LookAt:=xlWhole).Interior.ColorIndex
  Next c
End Sub

Colorier les colonnes en fonction du nombre de x dans les colonnes

On veut colorier chaues en fonction du nombre de x . Les couleurs sont définies dans une table Couleurs.

MFCColonnes

Private Sub Worksheet_Calculate()
  For i = 1 To [zone].Columns.Count
    n = Application.CountIf(Application.Index([zone], , i), "x")
    p = Application.Match(n, Sheets("couleurs").Range("couleurs"), 1)
    If Not IsError(p) Then
      Application.Index([zone], , i).Interior.ColorIndex = Sheets("couleurs").Range("couleurs")(p).Interior.ColorIndex
    End If
   Next i
End Sub

Colorier la date d'une colonne qui contient une valeur dans les lignes 4 à 24

La couleur est différente suivant que la date est à -à 60 jours, -à 45 jours, -à 30 jours -à 15 jours

MFCDates

Private Sub Worksheet_Calculate()
  [zoneDate].Interior.ColorIndex = xlNone
  For Each c In [zoneDate]
    n = Application.CountA(c.Offset(2).Resize(21))
    If n > 0 And c.Value - 60 < Date Then c.Interior.ColorIndex = 8
      If n > 0 And c.Value - 45 < Date Then c.Interior.ColorIndex = 5
      If n > 0 And c.Value - 30 < Date Then c.Interior.ColorIndex = 6
      If n > 0 And c.Value - 15 < Date Then c.Interior.ColorIndex = 3
   Next c
End Sub

ou

Private Sub Worksheet_Calculate()
  [zoneDate].Interior.ColorIndex = xlNone
  For Each c In [zoneDate]
    If Application.CountA(c.Offset(2).Resize(20)) > 0 Then
       temp = c.Value - Date
       If temp >= 0 And temp <= 60 Then
          c.Interior.ColorIndex = Array(3, 6, 7, 8)(Application.Match(temp, Array(0, 15, 30, 45, 60), 1) - 1)
       End If
     End If
   Next
End Sub

ou

Private Sub Worksheet_Calculate()
  [zoneDate].Interior.ColorIndex = xlNone
  For Each c In [zoneDate]
    n = Application.CountA(c.Offset(2).Resize(20))
    coul = ((c.Value - Date) \ 15)
    If n > 0 And coul < 5 Then c.Interior.ColorIndex = Array(3, 6, 7, 8)(coul)
  Next c
End Sub

BD sous forme de planning

Format/MFC/La formule est:
=SOMMEPROD((Noms=$A3)*(B$2>=Début)*(B$2<=Fin))

Planning de tâches

En E4:=SI(ET(E$3>=$C4;E$3<$C4+$D4);$B4;"")

PlanTâches

Le coloriage du planning se fait avec

Private Sub Worksheet_Calculate()
  Application.ScreenUpdating = False
  For Each c In [zoneMFC]
    c.Interior.ColorIndex = xlNone
    If c.Value <> "" Then
      On Error Resume Next
      c.Interior.ColorIndex = [Couleurs].Find(c.Value, LookAt:=xlWhole).Interior.ColorIndex
      c.Font.ColorIndex = [Couleurs].Find(c.Value, LookAt:=xlWhole).Font.ColorIndex
    End If
  Next c
End Sub

MFC image

Pour une cellule

On veut afficher une des images en D1,E1,F1 suivant que B7 est >100,>50 et <100, <50

MFCimageUneCellule

-Créer un nom de champ ADR =SI($B$7>100;$D$1;SI($B$7>50;$E$1;$F$1))
-En C6, importer une image
-Sélectionner cette image
-Dans la barre de formule, frapper =ADR at valider avec Entrée

Pour plusieurs cellules

MFC images
MFC images2

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 8 Then
    '-- suppression
    For Each s In ActiveSheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    Sheets("status").Shapes(Application.Substitute(Target, " ", "")).Copy
    Target.Offset(0, 1).Select
    ActiveSheet.Paste
    Selection.ShapeRange.Left = ActiveCell.Left + 9
    Selection.ShapeRange.Top = ActiveCell.Top + 5
    Target.Select
  End If
End Sub

MFC sur commentaire

Colorie les cellules contenant un commentaire

=EstCommentaire(A2)

Dans un module:

Function EstCommentaire(c)
  Application.Volatile
  EstCommentaire = Not c.Comment Is Nothing
End Function

Met en gras les cellules contenant ok dans le commentaire.

=ESTNUM(CHERCHE("OK";comment(A2)))

Dans un module:

Function Comment(c)
  Application.Volatile
  If c.Comment Is Nothing Then
     Comment = ""
  Else
     Comment = Replace(c.Comment.Text, Chr(10), "")
  End If
End Function

MFC avec fonction d'affichage d'un message dans un commentaire

La MFC classique permet de modifier la couleur mais ne permet pas d'afficher des messages.
La fonction AfficheCmt(cel, condition, msg, coul) en B3 crée un commentaire en A3 si A3 dépasse la valeur en B1.

FonctionAfficheCmtCondition
FonctionAfficheCmt
FonctionAfficheCmt2

La condition doit être spécifiée entre ().

Function AfficheCmt(cel, cond, msg, coul)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  If Not cel.Comment Is Nothing Then cel.Comment.Delete
  If cond Then
    With cel
      If .Comment Is Nothing Then .AddComment
       .Comment.Shape.Width = Len(msg) * 6
       .Comment.Shape.Height = 10
       .Comment.Shape.Left = .Left + .Width + 5
       .Comment.Shape.Top = .Top - 2
       .Comment.Visible = True
       .Comment.Text Text:=msg
       .Comment.Shape.Fill.ForeColor.SchemeColor = coul
     End With
   End If
   AfficheCmt = ""
End Function

Attention! si on protège la feuille, cocher Objets lors de la protection.

La fonction AfficheCmt(cel, condition, msg, coul) en B12 crée un commentaire en B11 si le total CA en B11 dépasse l'objectif en B2.

La condition peut être une expression complexe

Sur cet exemple, les caractères accentués ne sont pas autorisés

En B2:
=Affichecmt(A2;(SOMMEPROD((A2<>"")*(ESTERREUR(CHERCHE(STXT(A2;LIGNE(INDIRECT("1:"&NBCAR(A2)));1);"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz @-_.0123456789"))))
)
;"Caractère invalide";2)

La fonction afficheCmtMax(champ) crée un commentaire dans la cellule qui contient le maximum d'un champ.

FonctionCommentaireMax

Function afficheCmtMax(champ)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  For Each c In champ
    If Not c.Comment Is Nothing Then c.Comment.Delete
  Next c
  lig = champ.Row + Application.Match(Application.Max(champ), champ, 0) - 1
  col = champ.Column
  With f.Cells(lig, col)
   If .Comment Is Nothing Then .AddComment
   .Comment.Shape.Width = 32
   .Comment.Shape.Height = 10
   .Comment.Shape.Left = .Left + .Width + 5
   .Comment.Shape.Top = .Top - 5
   .Comment.Visible = True
   Select Case Application.Max(champ)
     Case 0 To 30
       msg = "Bof"
       coul = 2
    Case 31 To 50
       msg = "ok"
       coul = 7
    Case Is > 50
       msg = "Bravo!"
       coul = 5
   End Select
   .Comment.Text Text:=msg
   .Comment.Shape.Fill.ForeColor.SchemeColor = coul
  End With
  afficheCmtMax = ""
End Function

MFC avec photo dans un commentaire

Affiche une photo dans un commentaire dans la cellule qui contient le maximum d'un champ.
Les photos doivent être dans le même répertoire que le classeur.

FonctionCommentaireMaxPhoto

Function AfficheCmtPhotoMax(champ As Range, champNom As Range)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  For Each c In champ
     If Not c.Comment Is Nothing Then c.Comment.Delete
  Next c
  lig = champ.Row + Application.Match(Application.Max(champ), champ, 0) - 1
  col = champ.Column
  With f.Cells(lig, col)
    If .Comment Is Nothing Then .AddComment
    répertoire = ThisWorkbook.Path & "\"
    nom = champNom(Application.Match(Application.Max(champ), champ, 0))
    If Dir(répertoire & nom & ".jpg") <> "" Then
      .Comment.Shape.Left = .Left + .Width + 5
      .Comment.Shape.Top = .Top - 5
      .Comment.Visible = True
      .Comment.Text Text:=" "
      .Comment.Shape.Fill.UserPicture répertoire & nom & ".jpg"
      .Comment.Shape.Height = 30
      .Comment.Shape.Width = 30
      .Comment.Shape.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
     End If
   End With
   AfficheCmtPhotoMax = ""
End Function

Fonction d'affichage d'une jauge sur un champ en fonction d'un taux de réalisation

La fonction Jauge(taux, champJauge As Range,Largeur,Transparence) crée sur le champ spécifié un shape proportionnel au taux de réalisation (0%->100%)

FonctionJaugeVerticale
FonctionJaugeVerticale2
FonctionJaugeHorizontale
FonctionJaugeHorizontale2

Pour obtenir une jauge sur 40% de la largeur de colonne et non transparente.

En B12:=jauge(B11/B2;B4:B9;40%;0)

Pour obtenir une jauge sur la largeur de la colonne et transparente à 70%.

En B12:=jauge(B11/B2;B4:B9;100%;70%)

        

Function Jauge(taux, champJauge As Range, largeur, transparence)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  NomShape = "S" & Application.Caller.Address
  NomShape2 = NomShape & "-x"
  For Each s In f.Shapes
    If s.Type = 1 Then
       If Not Intersect(s.TopLeftCell, champJauge) Is Nothing Then
         If Right(s.Name, 2) = "-x" Then temp = Left(s.Name, Len(s.Name) - 2) Else temp = s.Name
         If UCase(temp) <> UCase(NomShape) Then s.Delete
      End If
    End If
  Next s
  For Each s In f.Shapes
     If UCase(s.Name) = UCase(NomShape) Then ok = True
  Next s
  If Not ok Then
    f.Shapes.AddShape(msoShapeRectangle, 120#, 258.75, 52.5, 34.5).Name = NomShape
    f.Shapes(NomShape).Fill.ForeColor.SchemeColor = 9
    NomShape2 = NomShape & "-x"
    f.Shapes.AddShape(msoShapeRectangle, 120#, 258.75, 52.5, 34.5).Name = NomShape2
  End If
  If taux > 1 Then taux = 1
  f.Shapes(NomShape2).Fill.ForeColor.SchemeColor = IIf(taux < 0.5, 2, 3)
  f.Shapes(NomShape).Fill.Transparency = transparence
  f.Shapes(NomShape).Width = champJauge.Width * largeur
  f.Shapes(NomShape).Height = champJauge.Height * (1 - taux)
  f.Shapes(NomShape).Top = champJauge.Top
  f.Shapes(NomShape).Left = champJauge.Left

  f.Shapes(NomShape2).Fill.Transparency = transparence
  f.Shapes(NomShape2).Width = champJauge.Width * largeur
  f.Shapes(NomShape2).Height = champJauge.Height * taux
  f.Shapes(NomShape2).Top = champJauge.Top + champJauge.Height * (1 - taux)
  f.Shapes(NomShape2).Left = champJauge.Left
  Jauge = ""
End Function

Avec =jauge(B10/B2;B10;40%;0), on obtient

FonctionJauge2

Si le champ qui recoit la jauge contient des cellules fusionnées remplacer champ.Height par champJauge.MergeArea.Height.

Fonction jaugeTriangle(Taux;ChampJauge)

En B11: =jaugeTriangle(B10/B2;B4:B9)

FonctionJaugeTriangle

Fonction Jauge(taux, champJauge As Range, hauteur)

JaugeCompteur

     

MFC par modification de la transparence de shapes

La fonction Transparent(nomShape, cellule, taux) modifie la transparence de shapes en fonction de la valeur de la cellule
par rapport au maximun des cellules du champ B11:F11.
Si le shape n'existe pas, il est crée et positionné par la fonction.

Transparence
Transparence2

Function Transparent(cel, taux)
  Set f = Sheets(Application.Caller.Parent.Name)
  NomShape = "S" & Application.Caller.Address
  For Each s In f.Shapes
    If s.Type = 17 Then
      If s.TopLeftCell.Address = cel.Address Then
        If UCase(s.Name) <> UCase(NomShape) Then s.Delete
      End If
    End If
  Next s
  For Each s In f.Shapes
    If UCase(s.Name) = UCase(NomShape) Then ok = True
  Next s
  If Not ok Then
    f.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 100, 50).Name = NomShape
    f.Shapes(NomShape).Fill.ForeColor.SchemeColor = 2 '3=vert 4:bleu 13:jaune 2:rouge
  End If
  f.Shapes(NomShape).Fill.Transparency = 1 - (100 * taux) / 170
  f.Shapes(NomShape).Width = cel.Width
  f.Shapes(NomShape).Height = cel.Height
  f.Shapes(NomShape).Top = cel.Top
  f.Shapes(NomShape).Left = cel.Left
  Transparent = ""
End Function

Transparence et couleur d'un shape en fonction du % Objectif/Réalisé

En B13:
=SI(B12<100%;Transparent(B12;B12;2);Transparent(B12;100%;3))

Transparence3

Forme, couleur et transparence d'un shape en fonction du % Total/an-1

-Pour les % positifs, un shape FlècheHaut vert est affiché.
-Pour les % négatifs, un shape FlècheBas vert est affiché.
-
La transparence est fonction de la valeur du pourcentage.

En B13: =SI(B12>0;Transparent(B12;B12;3;100%);Transparent(B12;B12;2;100%))

Pour afficher les flèches sur le champ B4:B9 sur la moitié de la colonne:

En B13: =SI(B12>0;Transparent(B4:B9;B12;3;50%);Transparent(B4:B9;B12;2;50%))

Transparence4

   

Le dégradé du % de chaque produit est calculé en tenant compte du pourcentage maximum (20% sur l'exemple)

FonctionFlèche

Fonction d'affichage d'un shape & d'un message

Cette fonction Affiche(couleur;message) crée un shape dans la cellule où est elle est écrite et afiiche un message.

Fonction AfficheMessage

En B11:
=SI(B10>300;Affiche(2;"Excellent!");SI(B10>200;Affiche(3;"Super!");SI(B10>100;Affiche(5;"Bravo!");Affiche(9;""))))

Fonction d'affichage d'une image d'arrière-plan dans un champ

Cette fonction =ArrierePlan(NomPhoto;ChampArrièrePlan;RépertoirePhoto) crée un shape et le positionne sur le champ spécifié.

-Pour déplacer les shapes, cliquer dessus
-F9 pour les replacer sur le champ

Fonction Arrière-Plan

En B12:
=ArrierePlan(B1;B4:B9;"c:\mesdoc\")

Arrière-plan variable en fonction du mois

Arrière-PlanVariable

Construction de feux tricolores

Cette fonction Feu(Pourc, champAffFeu) construit des feux tricolores en fonction d'un % et les affiche à l'endroit spécifié.

-Rouge si %<0
-Orange si %=0
-Vert si %>0

ConstructtionFeux

Function Feu(Pourc, champAffFeu)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  NomFeu = "S" & Application.Caller.Address
  If Pourc < 0 Then no = 1 Else If Pourc = 0 Then no = 2 Else no = 3
  For Each s In f.Shapes
    If s.Type = 1 Then
      If Not Intersect(s.TopLeftCell, champAffFeu.Resize(2)) Is Nothing Then
         If Mid(s.Name, Len(NomFeu) + 1, 1) = "C" Then
           temp = Left(s.Name, Len(s.Name) - 2)
         Else
           temp = s.Name
         End If
         If UCase(temp) <> UCase(NomFeu) Then s.Delete
       End If
    End If
  Next s
  For Each s In f.Shapes
     If UCase(s.Name) = UCase(NomFeu) Then ok = True
  Next s
  If Not ok Then
    f.Shapes.AddShape(msoShapeRectangle, 15, 15, 16, 48).Name = NomFeu
    f.Shapes(NomFeu).Fill.ForeColor.SchemeColor = 0
    For c = 1 To 3
      f.Shapes.AddShape(msoShapeOval, 15 + 3 * (c - 1) * 15, 15 + 3, 10, 10).Name = NomFeu & "C" & c
    Next
  End If
  f.Shapes(NomFeu).Top = champAffFeu.Top + 2
  f.Shapes(NomFeu).Left = champAffFeu.Left + 5
  For c = 1 To 3
    f.Shapes(NomFeu & "C" & c).Top = champAffFeu.Top + (c - 1) * 15 + 6
    f.Shapes(NomFeu & "C" & c).Left = champAffFeu.Left + 8
    f.Shapes(NomFeu & "C" & c).Fill.ForeColor.SchemeColor = 0
    f.Shapes(NomFeu & "C" & c).Line.Visible = True
    f.Shapes(NomFeu & "C" & c).Line.ForeColor.SchemeColor = 1
  Next c
  f.Shapes(NomFeu & "C" & no).Fill.ForeColor.SchemeColor = Array(2, 52, 3)(no - 1)
  Feu = ""
End Function

Surligner les nombres qui ont les mêmes 9 premiers chiffres

MFC: La formule est =SOMMEPROD(--(GAUCHE(A2;9)=GAUCHE($A$2:$A$8;9)))>1

Si les nombres sont au format texte =NB.SI($A$2:$A$8;GAUCHE(A2;9)&"*")>1

MFC multi-feuilles

La MFC s'applique aux feuilles Mois1,Mois2,...
On modifie le format de la colonne I en fonction de la saisie en colonne D

MFCMultiFeuilles

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Left(Sh.Name, 4) = "Mois" Then
    If Target.Column = 4 Then
       Application.EnableEvents = False
       On Error Resume Next
      [Couleurs].Find(Target, LookAt:=xlWhole).Copy
      Target.Offset(, 5).PasteSpecial Paste:=xlPasteFormats
      Application.EnableEvents = True
    End If
  End If
End Sub

Comparaison de 2 BD par MFC

Les codes et les pays doivent coïncider. Les pays ne sont pas écrits de la même façon dans les 2 BD(Voir table traduction).

MFC En D2 de File1:
=ESTNA(EQUIV($D2;Code2;0))
=ESTNA(EQUIV(1;(country1=$G2)*(country2=SUPPRESPACE(INDEX(pays2;EQUIV($D2;Code2;0))));0))

MFC en A2 de File2:
=ESTNA(EQUIV(1;(country2=SUPPRESPACE($F2))*(country1=SUPPRESPACE(INDEX(pays1;EQUIV($A2;Code1;0))));0))

BDCompareMFC

Repérage de doublons dans des champs 3D avec MFC

MFC: =SOMMEPROD(--(NB.SI(INDIRECT("'"&nf&"'!A2:B10");A2)>0))>1

Doublons Champ 3D MFC
Doublons multi-colonnes 3D MFC

Doublons de champs 3D+ doublons dans chaque champ avec MFC

=SOMMEPROD((--(NB.SI(INDIRECT("'"& nf &"'!A2:B10");A2)>0))+
(--(NB.SI(INDIRECT("'"& nf &"'!A2:B10");A2)>1)))>1

Doublons entre plusieurs champs avec MFC

MFC
=SOMMEPROD(--(NB.SI(INDIRECT(NomChamp);A2)>0))>1
ou
=SOMMEPROD(--(NB.SI(INDIRECT("champ"&LIGNE($1:$4));A2)>0))>1

Doublons multi-champ MFC

MFC inversé

Un texte apparaît dans une cellule en fonction de la couleur qu'on lui a affecté.

MFCInverse

Modifie le texte en fonction de la couleur. Avec le pinceau, la maj est immédiate.

Function couleurFondTexte()
  Application.Volatile
  Select Case Range(Application.Caller.Address).Interior.ColorIndex
    Case 3
      couleurFondTexte = "Ok"
    Case 4
      couleurFondTexte = "Ko"
    Case 6
      couleurFondTexte = "En cours"
    Case Else
       couleurFondTexte = ""
   End Select
End Function

MFC sur la couleur

On veut comparer 2 tableaux.
Il faut que les cellules surlignées en vert dans le premier tableau deviennent vertes dans le second tableau par MFC.

MFCCouleur

*Définir un nom de champ Macouleur
-Placer le curseur sur B15
-Insertion /nom/définir
=LIRE.CELLULE(38;Feuil1!B4)+INDIRECT("iv65000")

*MFC sur le second tableau
-Sélectionner B15:M22
-Format/Mise en forme conditionnelle
=Macouleur=4

*Pour Maj F9

*Pour Maj immédiate,utiliser le pinceau ou

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Calculate
End Sub

Coloriage d'un image en fonction d'une valeur

En fonction du total en B8, on colorie l'image ZT1

-Au dessus de 500 -> Vert
-Entre 250 et 500 -> Orange
-Moins de 250 -> Rouge

=ColorieImage("ZT1";SI(B8>500;65025;SI(B8>250;4626167;255)))

Function ColorieImage(s, couleur)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  f.Shapes(s).Fill.ForeColor.RGB = couleur
End Function

ColoriageImage
ColoriageImage3
ColoriageImage3B
ColoriageImage4

Colorie une image avec la couleur d'une cellule

ColoriageImageCouleurCellule

Function ColorieImage(s, couleur)
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  f.Shapes(s).Fill.ForeColor.RGB = couleur
End Function

Function CouleurCellule(c As Range)
  Application.Volatile
  CouleurCellule = c.Interior.Color
End Function

MFC pour comparer 2 listes avec ou sans accents

On veut colorier les éléments communs entre 2 listes avec ou sans accents.

Communs M FCAccents

MFC: =EQUIV($C2;sansaccentm(Base1);0)

Liste1
ANTELME Benoît
AUBRY Stéphane
BADOUAL Pacome
BARKAN Imane
BDELHADI Lilia
BDUL Habibola
CHERGUI Amine
DAM Cyrille

Liste2
ANTELME Benoit
AUBRY Stephane
BALADA Filipe
DUPONT Pierre
BDELHADI Lilià
BDOU Claire
CHERGUI Amîne
BADOUAL Pacôme

Compter le nombre de cellules d'un champ ayant une couleur MFC

CompteCouleurMFC

Function compteCoulMFC(champ As Range, coul)
  Application.Volatile
  For Each c In champ
   If CouleurMFC(c) = coul Then
       t = t + 1
   End If
  Next c
compteCoulMFC = t
End Function

Function CouleurMFC(cel)
  Application.Volatile
  Set c = Range(cel.Address)
  ff = Array("Somme", "aujourdhui()", "nb.si", "equiv", "recherchev", _
    "Nbval", "sommeprod", "joursem", "gauche", "droite", "stxt")
  fa = Array("Sum", "today()", "countif", "match", "vlookup", _
     "counta", "sumproduct", "weekday", "left", "right", "mid")
  a = Array("=", ">", "<", ">=", "<=", "<>", "BETWEEN")
  b = Array(xlEqual, xlGreater, xlLess, xlGreaterEqual, xlLessEqual, xlNotEqual, xlBetween)
  i = 1
  Do While i <= c.FormatConditions.Count And Not témoin
    If c.FormatConditions(i).Type = xlCellValue Then
    tmp1 = Evaluate(c.FormatConditions(i).Formula1)
    oper = a(Application.Match(c.FormatConditions(i).Operator, b, 0) - 1)
    If oper <> "BETWEEN" Then
      If Evaluate(c & oper & tmp1) Then
        coul = c.FormatConditions(i).Interior.ColorIndex
        témoin = True
      End If
    Else
      tmp2 = Evaluate(c.FormatConditions(i).Formula2)
      If Evaluate("AND(" & c & ">=" & tmp1 & "," & c & "<=" & tmp2 & ")") Then
         coul = c.FormatConditions(i).Interior.ColorIndex
         témoin = True
      End If
    End If
  Else
     z = c.FormatConditions(i).Formula1
     For k = LBound(ff) To UBound(ff)
       z = Replace(z, UCase(ff(k)), UCase(fa(k)))
     Next k
     If Evaluate(z) = True Then
        coul = c.FormatConditions(i).Interior.ColorIndex
        témoin = True
     End If
   End If
   i = i + 1
  Loop
  CouleurMFC = coul
End Function

On peut également compter de cette façon dans une procédure:

Sub compte()
  For Each c In [A1:A5]
    If CouleurMFC(c) = 3 Then
        t = t + 1
    End If
  Next c
  MsgBox t
End Sub

Somme des cellules ayant une couleur de fond MFC:

Function SommeCoulMFC(champ As Range, coul)
  Application.Volatile
  t = 0
  For Each c In champ
    If CouleurMFC(c) = coul Then
      t = t + c.Value
    End If
  Next c
  SommeCoulMFC = t
End Function

 

 

 

 

 

 

 

 

 

 

 

 

 

Exemples

Formats conditionnels synthèse
Formats conditionnels synthèse 2007
Sous totaux
MFC Plus 3 couleurs
MFC plus 3 couleurs
BD compare MFC
Barre boutons coloriage1
Barre boutons coloriage2
Coloriage ligne
MFC images
MFC formules
MFC filtre 1 ligne sur 2