Discussion :

[graphikris]

Bonjour,
Je dispose d'une BdD dans laquelle je suis des dates par individus.

Colonne A : Noms des individus
Colonne B à colonne G: des Dates

Toutes ces dates ont des MFC, en fonction de certains critères.
Dès que les dates dépassent le critére alors le fond des cellules concerné se colorie en ROUGE.

Je voudrais que la cellule H2 se colorie en ROUGE si au moins une des cellules des colonnes B2:G2 est ROUGE.

Idem jusqu'en H10

Puis en Cellule H11, il faudrait qu'excel fasse la somme des cellules ROUGE de H2 à H10

Cordialement,
Graphikris.

[Daniel.C]

Bonjour,

Ce qui est plus simple que de chercher les couleurs conditionnelles, c'est d'utiliser la valeurs ou les formules gérant la MFC pour faire tes sommes.

[goldstar]

Bonjour ,

Un truc du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Sub maj_couleur_cellule()
 
Dim cpt_l As Integer, cpt_c As Integer
Dim nb_cellule_rouge As Integer
 
nb_cellule_rouge = 0
 
Sheets("Feuil1").Activate
 
For cpt_l = 2 To Range("a" & Rows.Count).End(xlUp).Row
    For cpt_c = 2 To 7
        If ActiveSheet.Cells(cpt_l, cpt_c).Interior.ColorIndex = 3 Then
            'Dès que les dates dépassent le critére alors le fond des cellules concerné se colorie en ROUGE.
            ActiveSheet.Cells(cpt_l, 8).Interior.ColorIndex = 3
            nb_cellule_rouge = nb_cellule_rouge + 1
            Exit For
        End If
    Next cpt_c
 
Next cpt_l
 
'Puis en Cellule H11, il faudrait qu'excel fasse la somme des cellules ROUGE de H2 à H10
ActiveSheet.Cells(11, 8) = nb_cellule_rouge
 
End Sub

Cordialement

[graphikris]

Bonjour et merci,

çà marche bien mais un petit souci. Lorsqu'une ligne ne possèdent plus aucune date dépassée (ex : L 05) alors en H05, la cellule reste rouge, elle ne passe pas au (sans fond coloré) . Par contre le calcul final est correct.

Cordialement
Graphikris.

[graphikris]

Bonjour,

Ci-joint un nouveau classeur avec des vraies dates et des MFC réélles,
ATTENTION / En fonction des modules, la validité est différente.

Et sinon une nouveauté par rapport au post initial, il y a désormais des cellules bleues.

L'explication est mise sur le classeur joint en Q2 feuil1

Cordialement
Graphikris.

[Daniel.C]

Bonjour,

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub test()
'Set Var = ActiveCell.FormatConditions
Dim C As Range, Ctr As Byte, Jours As Integer, tot As Integer
With Sheets("Feuil1")
    For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 14)
        Ctr = 0
        For i = 2 To 13
            For x = 1 To .Cells(C.Row, i).FormatConditions.Count
                Set Var = .Cells(C.Row, i).FormatConditions
                Var = .Cells(C.Row, i).FormatConditions(x).Formula1
                If Left(Var, 8) = "=ESTVIDE" Then
                    If .Cells(C.Row, i) = "" Then
                        Ctr = Ctr + 1
                        Exit For
                    End If
                End If
                If InStr(1, Var, "INAPTE") > 0 Then
                    If .Cells(C.Row, i) = "INAPTE" Then
                        Ctr = Ctr + 1
                        Exit For
                    End If
                End If
                If InStr(1, Var, "AUJOURDHUI") > 0 Then
                    Jours = CInt(Split(Var, "-")(1))
                    If .Cells(C.Row, i) < Date - Jours Then
                        Ctr = Ctr + 1
                        Exit For
                    End If
                End If
            Next x
        Next i
        If Ctr = 12 Then
            C.Interior.ColorIndex = 3
            tot = tot + 1
        Else
            C.Interior.ColorIndex = xlNone
        End If
    Next C
    .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 15) = tot
End With
End Sub