Compter les cellules de couleur par ligne

Bonjour,

Sur un onglet j'ai un tableau avec des salariés en ligne et des jours en colonne. Si le salarié est en congé, la cellule est en couleur.

J'ai besoin de récupérer le nombre de cellule d'une couleur précise et de stocker le résultat par salarié....

A ce jour, je ne parviens qu'à compter les cellules de la couleur (ce qui fonctionne) avec le code suivant :

Sub ComptColor()

Dim color As Long
Dim number As Long

color = 3

For Each cel In Range("A1:LC300")
If cel.Interior.ColorIndex = 3 And cel.Value <> "X" And cel.Value <> "F" Then
number = number + 1
End If
Next cel

MsgBox number

End Sub

Y aurait-il une âme charitable pour m'aider ?

Au lieu du MsgBox je souhaite mettre à la fin du tableau la somme des cellules en couleur (rouge, valeur 3 et sans les cellules avec F ou X dedans) par salarié (donc une somme par ligne)

Bonjour,

Voici une proposition:

Sub ComptColor()

Dim color As Long
Dim number As Long

color = 3

For Each cel In Range("A1:LC300")
If cel.Interior.ColorIndex = 3 And cel.Value <> "X" And cel.Value <> "F" Then
number = number + 1
End If
Next cel

range("LD1")= number

End Sub

Merci pour la réponse mais si je ne me trompe pas, votre code va compter le nombre total de cellule rouge et mettre la valeur le cellule LD1.

Ce qui me faut c'est :

le nombre de cellule rouge de la ligne 5 --> son total à mettre en GF5

le nombre de cellule rouge de la ligne 6 --> son total à mettre en GF6

En gros je pense qu'il faut un do loop mais étant débutant en VBA je galère !

Edit : j'ai tenter le do loop mais le résultat ne convient pas, la ligne 5 est bonne mais la ligne 6 correspond au total de la 5 + la 6....

Voila le nouveau code :

Sub ComptColor2()

Dim color As Long
Dim number As Long

color = 3
i = 4

Do
i = i + 1
Row = i & ":" & i
For Each cel In Range(Row)
If cel.Interior.ColorIndex = 3 And cel.Value <> "X" And cel.Value <> "F" Then
number = number + 1
End If
Next cel
Range("GF" & i).Value = number
'Exit Do
Loop While i < 120

End Sub

Bonsoir,

Il serait plus facile de vous aider si vous joigniez à votre demande un fichier anonymisé, ce qui faciliterait pour les contributeurs la bonne compréhension du résultat attendu.

Slts

Bonjour,

Avec un fichier joint (sans données confidentielles) ce serait plus simple sinon, essayez ceci:

Option Compare Text

Sub ComptColor()
    Dim DerLig As Long, DerCol As Long
    Dim Total As Long, i As Long, j As Long
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    DerCol = 315 'Colonne LC
    For i = 2 To DerLig
        Cpt = 0
        For j = 2 To DerCol
            If Cells(i, j).Interior.ColorIndex = 3 And Cells(i, j).Value <> "X" And Cells(i, j).Value <> "F" Then
                Cpt = Cpt + 1
                Total = Total + 1
            End If
        Next j
    Next i
    Range("LD1").Value = Total
End Sub
Option Compare Text

**********************************************************************************************************************

Si la couleur rouge est obtenue par une mise en forme conditionnelle, le code ci-dessus n'est pas valable, dans ce cas il faudrait nous dire quel est le contenu de la cellule qui permet de passer la cellule en rouge.

Exemple de code si la cellule contient "CA" pour congé annuel, dans ce cas on compte la présence des "CA" et non plus la couleur rouge:

Sub ComptColor2()
    Dim DerLig As Long
    Dim Total As Long, i As Long, j As Long
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig
        Cells(i, "LD") = Application.WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, "LC")), "CA")
    Next i
    Range("LD1").Value = Application.WorksheetFunction.Sum(Range(Cells(2, "LD"), Cells(DerLig, "LD")))
End Sub

Cdlt

bonjour VdoTers, Salut Arturo83,

on peut aussi compter comme ceci

If Cells(i, j).DisplayFormat.Interior.ColorIndex = 3 And ....

Voila le fichier, en gros colonne GG je devrais avoir la sommes de cellules rouges de chaque ligne. Mais avec le do loop fait, j'ai un cumul

En recopiant le code, j'ai écrasé une ligne, correctif:

Sub ComptColor()
    Dim DerLig As Long, DerCol As Long
    Dim Total As Long, i As Long, j As Long
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    DerCol = 188 'Colonne GF
    For i = 5 To DerLig
        Cpt = 0
        For j = 2 To DerCol
            If Cells(i, j).Interior.ColorIndex = 3 And Cells(i, j).Value <> "X" And Cells(i, j).Value <> "F" Then
                Cpt = Cpt + 1
                Total = Total + 1
            End If
        Next j
        Cells(i, "GG") = Cpt
    Next i

    Range("GG1").Value = Total
End Sub

Cdt

Parfait ! merci beaucoup :)