Microsoft 365 Calculer les valeurs des cellules selon la couleurs de fond en VBA. Donc automatiquement

[Flaconblack59]

Bonjour

Novice sur Excel, est-ce que quelqu'un pourrait m'aidée svp.
Je cherche à résoudre ma Macro que j'arrive plus à mètre en place.
Sachant que chaque cellule son de 0,25 et se calcul selon la couleur de fond mis par cellule.

Quel serait la Macro à mettre en place pour y résoudre d'après cette formule ci-dessous ?
=@NbColorAndTextSameAs(F8:AN63;Données!$D$3)/4+@NbColorAndTextSameAs(F64:AN67;Données!$C$3)

Ce la permet de calculer automatiquement les valeurs des cellules en actionnant le bouton calcul.

Vous remerciant d'avance

 

[Dranreb]

Bonjour.
Rien compris à vos explications, et le projet VBA de votre classeur est protégé par un mot de passe.
Mais le module de classe Couleur de mon fichier CouleurCls.xlsm pourrait offrir une correspondance simple entre un nombre et un angle de teinte.

Élaboration et utilisation de jeux de couleurs.

Mise au point facile de jeux de couleurs pour UserForm, Shape et cellules, voire images calculées. Possibilité de capturer un pixel n'importe où sur l'écran. Module de classe Couleur pour utilisation dans d'autres projets VBA.

excel-downloads.com

 

[Dranreb]

Remarque: il vaudrait mieux que la valeur de la cellule soit initialisée, même si on ne la voit pas.
Function Coul qui répercute en différé la valeur sur la couleur de fond.

 

[Flaconblack59]

Remarque: il vaudrait mieux que la valeur de la cellule soit initialisée, même si on ne la voit pas.
Function Coul qui répercute en différé la valeur sur la couleur de fond.

Bonjour, je suis désolé pour m'es explication et comme je suis novice sur Excel, mais sais pas grave.
Merci pour votre aide

 

[Staple1600]

Bonsoir le fil

Sorti de la poussière de mes archives

Function ColourCount(cel As Range, ran As Range) As Long
    Dim colo As Long
    Dim c As Range
    Dim cou As Long
    colo = cel.Interior.ColorIndex
    For Each c In ran
        If ran.Parent.Evaluate("DColorIndex(" & c.Address & ")") = colo Then
            cou = cou + 1
        End If
    Next c
    ColourCount = cou
End Function
Function ColourSum(cel As Range, ran As Range) As Double
    Dim colo As Long
    Dim c As Range
    Dim colsum As Double
    colo = cel.Interior.ColorIndex
    For Each c In ran
        If ran.Parent.Evaluate("DColorIndex(" & c.Address & ")") = colo Then
            colsum = colsum + c.Value
        End If
    Next c
    ColourSum = colsum
End Function
Function DColorIndex(r As Range) As Long
    DColorIndex = r.DisplayFormat.Interior.ColorIndex
End Function
'crédits : Hans Vogelaar

Mode d'emploi ci-dessous
(La couleur de référence est ici en C1)

NB: Pour mettre une macro dans un classeur
Faire ALT+F11 puis Insérer -> Module
Dans la partie droite de l'écran, copier/coller le code VBA
Pour retourner dans Excel faire de nouveau ALT+F11

 

[modus57]

Bonjour Staple1600,
Votre fonction est intéressante.
Petite remarque : si on colorie A1 D3 ne change pas ?

 

[Staple1600]

Bonjour le fil, @modus57


@modus57
Ce n'est point ma fonction
(voir les commentaires en fin de ligne)
😉

Avec ce petit ajout, et en appuyant sur F9, on arrive à compter des cellules colorés et où les sommer.

Function ColourCount(cel As Range, ran As Range) As Long
Dim colo&, cou&, c As Range
Application.Volatile
colo = cel.Interior.ColorIndex
    For Each c In ran
        If ran.Parent.Evaluate("DColorIndex(" & c.Address & ")") = colo Then
            cou = cou + 1
        End If
    Next c
ColourCount = cou
End Function

NB: Il faut conserver le reste du code en l'état.

 

[Flaconblack59]

Bonjour

modus57 et Staple1600​

Merci pour votre aide, je suis désolé
Justement sella est pas mal, mais mois je voulais rassembler les deux en un. Je m'explique ci-dessous.

C'est à dire ; dans mes cellules sur une colonne j'ais une valeurs X que je ne vois pas, car elle est de là même couleur que le fond de la cellule.

Ce que je cherche sais la somme, l'heure ou le nombre totale de toute les cellules qui on une valeurs d'après la couleur qu'on lui aura mis.