[Resolu] Compter MFC ou autre méthode

Shpountz

XLDnaute Occasionnel
Bonjour à tous

j'ai bien lu tout les messages concernant le comptage des cellules MFC et je me rends compte que c'est plus que difficile (enfin pour moi...)

J'aurai besoin de calculer le nombre de cellules en couleur et ce en fonction des couleurs de l'onglet "Reunion"
Je me demande si il y aurait une solution avec une autre méthode ?

Je joint un fichier et d'avance je remercie tout ceux qui se pencheront sur mon problème.

Amicalement
François
 

Fichiers joints

PMO2

XLDnaute Accro
Bonjour,
Comme vous utilisez des formules simples dans vos MFCs le code suivant devrait fonctionner. Ce ne sera pas le cas pour les MFCs utilisant des formules plus élaborées.
L'exemple fourni n'intéresse donc que votre problème particulier.

Copiez le code suivant dans un module Standard.
VB:
Sub aa()
Dim FC As FormatCondition
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim T()
Dim tempo
Dim i&
Dim bool As Boolean
'---
Set S = Sheets("Reunions")
S.Select
Set R = S.UsedRange
For Each C In R
  If Not IsError(C) Then
    For Each FC In C.FormatConditions
      If FC.Type = xlCellValue Then
        If C = Application.Evaluate(FC.Formula1) Then
          On Error Resume Next
          tempo = UBound(T)
          Err.Clear
          On Error GoTo 0
          If IsEmpty(tempo) Then
            ReDim Preserve T(1 To 2, 1 To 1)
            T(1, 1) = T(1, 1) + 1
            T(2, 1) = FC.Interior.Color
          Else
            bool = False
            For i& = 1 To UBound(T, 2)
              If T(2, i&) = FC.Interior.Color Then
                T(1, i&) = T(1, i&) + 1
                bool = True
                Exit For
              End If
            Next i&
            If Not bool Then
              ReDim Preserve T(1 To 2, 1 To UBound(T, 2) + 1)
              T(1, UBound(T, 2)) = 1
              T(2, UBound(T, 2)) = FC.Interior.Color
            End If
          End If
        End If
      End If
    Next FC
  End If
Next C
'--- Résultats dans une nouvelle feuille ---
Set S = Sheets.Add
For i& = 1 To UBound(T, 2)
  Set C = S.Cells(i&, 1)
  C = T(1, i&)
  C.Interior.Color = T(2, i&)
Next i&
End Sub
 

Fichiers joints

Shpountz

XLDnaute Occasionnel
Bonjour PMO2

Merci de vous pencher sur mon problème.
Votre formule fonctionne effectivement mais je me demande si il serait possible que le calcul s'effectue colonne par colonne.... à partir de la colonne W jusqu’à DN

Encore un grand merci pour votre aide

Amicalement
Francois
 

PMO2

XLDnaute Accro
Re,
Dans ce cas on peut utiliser une fonction personnalisée.
Copiez le code suivant dans un module Standard
VB:
Function pmo(Plage As Range, Gagnant As Boolean) As Long
'### La couleur qui correspond à la MFC du gagnant ###
'###     NE PAS CHANGER LA COULEUR DANS LA MFC     ###
Const GAGNANTCOLOR As Long = 16777062
'#####################################################
Dim FC As FormatCondition
Dim C As Range
Dim Result As Long
'---
For Each C In Plage
  If Not IsError(C) Then
    For Each FC In C.FormatConditions
      If FC.Type = xlCellValue Then
        If C = Application.Evaluate(FC.Formula1) Then
          If Gagnant Then
            If FC.Interior.Color = GAGNANTCOLOR Then
              Result = Result + 1
            End If
          Else
            If FC.Interior.Color <> GAGNANTCOLOR Then
              Result = Result + 1
            End If
          End If
        End If
      End If
    Next FC
  End If
Next C
Fonctionnement :
Tapez la formule =pmo(W$3:W$6;VRAI) pour le gagnant et =pmo(W$3:W$6;FAUX) pour les placés.
Les formules peuvent être étirées.
 

Fichiers joints

Shpountz

XLDnaute Occasionnel
Re bonjour

Super formule mais il y a un problème.
Cela compte aussi les cellules marrons et rouges dans le cas des placés...
Or je souhaiterais que cela ne compte que les cellules Vertes , Jaunes (pour les Bleus dans le cas des placés il me sera possible de les compter avec les gagnants...)

Donc je pense que =pmo(W$3:W$6;FAUX) ne fonctionne pas mais j'avoue être complétement incapable de la modifier

Encore merci
Amicalement
François
 

PMO2

XLDnaute Accro
Bonjour Shpountz,
Vous n'arrivez pas à extrapoler les pistes que je propose. Ce n'est pas grave.
Virez tous mes codes précédents et copiez celui qui suit dans un module Standard.
VB:
Sub GetColorsMFCs()
Dim FC As FormatCondition
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim i&
Dim Coll As Collection
'---
Set Coll = New Collection
Set S = Sheets("Reunions")
S.Select
Set R = S.UsedRange
For Each C In R
  If Not IsError(C) Then
    For Each FC In C.FormatConditions
      If FC.Type = xlCellValue Then
        On Error Resume Next
        Coll.Add CStr(FC.Interior.Color), CStr(FC.Interior.Color)
        On Error GoTo 0
      End If
    Next FC
  End If
Next C
'--- Les différentes couleurs des MFCs s'inscrivent en colonne A ---
If Coll.Count > 0 Then
  Set R = S.[a65536].End(xlUp).Offset(2, 0)
  Set R = R.Resize(R.Rows.Count + Coll.Count - 1, 1)
  Application.ScreenUpdating = False
  For i& = 1 To Coll.Count
    R(i&, 1).Interior.Color = Coll.Item(i&)
    R(i&, 1) = "mfcColor" & i&
  Next i&
  Application.ScreenUpdating = True
End If
End Sub

Function SOMME_COLORS_MFC(Plage As Range, UneCouleur As Range) As Long
Dim FC As FormatCondition
Dim C As Range
Dim Result As Long
'---
If UneCouleur.Cells.Count > 1 Then Exit Function
For Each C In Plage
  If Not IsError(C) Then
    For Each FC In C.FormatConditions
      If FC.Type = xlCellValue Then
        If C = Application.Evaluate(FC.Formula1) Then
            If FC.Interior.Color = UneCouleur.Interior.Color Then
              Result = Result + 1
            End If       
         End If
      End If
    Next FC
  End If
Next C
SOMME_COLORS_MFC = Result
End Function
MARCHE A SUIVRE
1) Il faut d'abord déterminer les couleurs des MFCs.
Lancez la macro GetColorsMFCs qui inscrira en colonne A les différentes couleurs.
Déplacez les cellules obtenues à votre convenance (je les ai mises en E8:E12 par exemple)
2) Tapez une formule pour chaque couleur. Exemple : voir en W8 =SOMME_COLORS_MFC(W$3:W$6;$E8)
3) Faites les sommes de ce qui vous intéresse. Exemple en W17 et W18
Toutes les formules peuvent être étirées.
 

Fichiers joints

Discussions similaires


Haut Bas