Macro avec 2 conditions pour calculer les congés

Question

Je suis tout juste novice en Macros VBA sur Excel et j'avoue que je suis totalement perdu ! J'ai récupéré la macro d'un collègue qui fonctionne très bien. Elle permet de faire la somme des cellules qui sont de la même couleur que la cellule référence. Les cellules colorées correspondent aux jours de congé des personnes correspondantes. Exemple: Cependant je dois rajouter des conditions à cette fonction. Je voudrais que la fonction continue de compter le nombre de cellules colorées (soit le nombre de jour de congé) mais qu'elle n'extrait que le nombre de cellules de l'équipe b par exemple (colonne E ci-dessus). Je sollicite donc de l'aide sur le fichier joint, la fonction est la suivante: Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean) Dim rCell As Range Dim lCol As Long Dim vResult lCol = rColor.Interior.ColorIndex If SUM = True Then For Each rCell In rRange If rCell.Interior.ColorIndex = lCol Then vResult = WorksheetFunction.SUM(rCell, vResult) End If Next rCell Else For Each rCell In rRange If rCell.Interior.ColorIndex = lCol Then vResult = 1 + vResult End If Next rCell End If ColorFunction = vResult End Function Merci d'avance, Olivier...

James007 · Answer

Ci-joint un exemple dans la cellule H27 ... En espèrant que cela t'aide...

James007 · Answer

Re,

La macro modifée avec l'ajout de la nouvelle condition de l'équipe ... et ...pour plus de lisibilité ...

Function ColorFunction(rColor As Range, rRange As Range, sTeam As String, Optional SUM As Boolean)
' ajout de variable sTeam : "A","B","C"
' exemple d'utilisation : =colorfunction($D27;H5:H24;"B";FAUX)

Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex

Application.Volatile
    If SUM = True Then
      For Each rCell In rRange
          If rCell.Interior.ColorIndex = lCol And UCase(Cells(rCell.Row, 5)) = UCase(sTeam) Then
              vResult = WorksheetFunction.SUM(rCell, vResult)
          End If
      Next rCell
    Else
      For Each rCell In rRange
          If rCell.Interior.ColorIndex = lCol And UCase(Cells(rCell.Row, 5)) = UCase(sTeam) Then
              vResult = 1 + vResult
          End If
      Next rCell
    End If
ColorFunction = vResult
End Function

En espèrant que cela t'aide

James007 · Answer

Re,

Content que tout fonctionne ...

Pour répondre à tes deux questions :

1. As-tu essayé d'utiliser ta fonction personnalisée depuis une autre feuille ?

Si oui, quel résultat as-tu obtenu ?

2. UCase ne sert qu'à passer en lettres capitales la lettre identifiante de l'équipe ... car souvent les utilisateurs peu attentifs utiliseront dans la feuille des lettres minuscules ... et deux secondes plus tard des majuscules dans la formule ...

ou bien ... le contraire ... avec UCase ... ces éventuels désagréments sont évités ...

James007 · Answer

Re,

Prenons les choses pas à pas ... et ...dans le bon sens ..

Je comprends que tu as ' hérité ' de cette macro ...

Avant toute chose ...Il faudrait l'adapter à ta façon de vouloir l'utiliser ...

Peux-tu expliquer comment tu l'utilises .. et joindre un fichier test ..

James007 · Answer

Merci pour le fichier et pour les explications ... Ci-joint ton fichier test En espèrant que cela t'aide...

James007 · Answer

Re-Bonjour,

Content que tout fonctionne ...

Merci pour tes remerciements

Si tu suis le cours VBA de Sébastien ... tu vas te constituer une base très solide ...

Ensuite, à mon humble avis, il faut te frotter à la réalité ... et utiliser chaque prétexte dans ton boulot comme une opportunité pour apprendre ...

A titre d'exemple ... tu viens de très bien le faire avec la fonction personnalisée dont tu avais ' hérité ' ...