Comptage céllules de couleur et aides formules

Bonjours a tous et toutes,

Voila donc débutant, j'ai déjà reçu de l'aide dans un précédent post ( que je remercie ) pour mettre une cellules de telles couleur par rapport a la lettre que je rentre dans la cellules et le décompte étais affiché dans une autre cellule . Mais le précédent projet n'étais pas totalement abouties .

Maintenant il es quasi terminé et j'aimerais y appliquer une macro qu on m'avais fait mais en changeant les noms des cellules ça ne marche pas donc soit si il étais possible de me " traduire" le code vba pour que je puisse l'adapter au nouveaux projets soit le corriger directement ( toutefois si il es tout de même possible de me le traduire afin que je sache comment faire si au cas ou je devais modifier) .

Voici le code en question :

Dim joursAff, c, jt, nJT

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

Set joursAff = Union(Range("D5:E51"), Range("H5:I51"))

If Target.Count > 1 Then GoTo fin

If Not Intersect(Target, joursAff) Is Nothing Then

If UCase(Target) = "M" Then

Target.Interior.Color = RGB(255, 0, 0) 'Maladie

ElseIf UCase(Target) = "R" Then

Target.Interior.Color = RGB(146, 208, 80) 'Repos

ElseIf UCase(Target) = "V" Then

Target.Interior.Color = RGB(255, 217, 102) 'Vacance

ElseIf UCase(Target) = "J" Then

Target.Interior.Color = RGB(214, 220, 228) 'JFG

ElseIf UCase(Target) = "RÉCUP" Then

Target.Interior.Color = RGB(0, 176, 240) 'Récup

End If

If Not IsNumeric(Target) Then

Target = ""

End If

End If

'On repère la 1° cellule où seront les résultats

Set nJT = Cells.Find("Nombre de jours travaillés", lookat:=xlWhole)

'On remet les compteurs à zéro

Range("F60:F64").ClearContents

For Each c In joursAff

If c.Interior.Color = RGB(255, 0, 0) Then

nJT.Offset(2, 1) = nJT.Offset(2, 1) + 0.25 'nbre de jours de maladie

ElseIf c.Interior.Color = RGB(146, 208, 80) Then

nJT.Offset(1, 1) = nJT.Offset(1, 1) + 0.25 'nbre de jours de repos

ElseIf c.Interior.Color = RGB(214, 220, 228) Then

nJT.Offset(4, 1) = nJT.Offset(4, 1) + 0.25 'nbre de JFG

ElseIf c.Interior.Color = RGB(255, 217, 102) Then

nJT.Offset(5, 1) = nJT.Offset(5, 1) + 0.25 'nbre de jours de vacanc

ElseIf c.Interior.Color = RGB(0, 176, 240) Then

nJT.Offset(3, 1) = nJT.Offset(3, 1) + 0.25 'nbre de jours de récup

End If

Next c

fin:

Application.EnableEvents = True

End Sub

Sub Evenement()

Application.EnableEvents = True

End Sub

eT je joins le fichier en question.

A savoir que j'aimerais que le résultats se fasse par semaine dans le tableau en " A65" et me mette le total mois a partir des cellules " S8 "

Merci d'avance.

8e.xlsm (86.68 Ko)
Rechercher des sujets similaires à "comptage couleur formules"