Compte cellules couleurs et MFC

M12

XLDnaute Accro

• 22 Janvier 2019

• #2

Bonjour,
Tu ne pourras pas compter des couleurs par fonction VBA pour des couleurs mise en place par MFC

et sur un module on ne nomme pas celui-ci avec le même nom que la macro ou fonction.

 

Vote positif 0 Vote négatif

chris

XLDnaute Barbatruc

• 22 Janvier 2019

• #3

Bonjour à tous

Petite précision.

On peut par VBA utiliser display.format pour tester la couleur d'une MFC mais ce ne peut être utilisé que dans une procédure pas une fonction personnalisée...

Donc nécessite un bouton pour lancer la procédure pour un calcul one shot et non automatique...

 

Dernière édition: 22 Janvier 2019

Vote positif 0 Vote négatif

Mapat

XLDnaute Occasionnel

• 22 Janvier 2019

• #4

Bonjour

Merci pour vos réponses
Avec ce comptage de couleurs, je voulais comptabiliser les heures qui sont découpées en 4 cellules
Serait-il possible d'écrire 15mn dans chaque cellule qui se colore ?

 

Vote positif 0 Vote négatif

M12

XLDnaute Accro

• 22 Janvier 2019

• #5

Re,

Un exemple en colonne ED qui reprend la formule de ta MFC avec une condition

 

Pièces jointes

• Planning Janvier 2019.xlsm

  195.4 KB · Affichages: 19

Vote positif 0 Vote négatif

Mapat

XLDnaute Occasionnel

• 22 Janvier 2019

• #6

Re,

Merci pour cette aide
La façon d'arriver est différente de l'idée de départ mais le but est atteint
Bonne journée

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 22 Janvier 2019

• #7

Bonjour à tous,

Des formules SOMMEPROD dans toutes les cellules (des milliers) prendront sans doute pas mal de temps à se calculer.

Cette macro s'exécute chez moi en 5,8 secondes :

Code:

Sub RepereCouleurs()
Dim t, c As Range, coul&, Z As Range, P As Range
t = Timer
For Each c In [E4:IY53] 'plage à adapter
    coul = c.DisplayFormat.Interior.ColorIndex
    If coul = xlNone Then
        Set Z = Union(IIf(Z Is Nothing, c, Z), c)
    ElseIf coul <> 48 And coul <> 49 Then 'ni gris ni bleu foncé
        Set P = Union(IIf(P Is Nothing, c, P), c)
    End If
Next
Application.ScreenUpdating = False
If Not Z Is Nothing Then Z.Replace 1, "", xlWhole 'RAZ
If Not P Is Nothing Then P.NumberFormat = "0": P = 1 'repère
MsgBox "Couleurs repérées en " & Format(Timer - t, "0.00 \s")
End Sub

Des 1 repèrent les couleurs, il suffira ensuite de multiplier leurs sommes par "0:15" pour obtenir les heures.

A+

 

Dernière édition: 22 Janvier 2019

Vote positif 0 Vote négatif