VBA : Compter les couleurs




Un de mes amis me demande, comment on pourrait cumuler le contenu de plusieurs cellules en fonction d'une couleur de fond appliquée à ces cellules ? Voici deux petites procédures VBA qui permettrons de résoudre facilement ce problème.

- 1 – Cette première procédure cumule simplement dans les cellules C1 à c5 les valeurs contenues dans des cellules de même couleur entre A1 et A10.

 Sub Cumul_couleur()
'déclaration des variables
Dim CouleurFond As Long
Dim LigneCumul As Long
Dim CouleurCumul As Long
Dim ligne As Long
'remise à zéro de cumuls précédent sans effacement de couleur
Range("c1:c5").ClearContents
For LigneCumul = 1 To 5
    Cells(LigneCumul, 3).Select
'récupération de la 1er couleur de cumul
    CouleurCumul = Selection.Interior.ColorIndex
    For ligne = 1 To 10
        Cells(ligne, 1).Select
        CouleurFond = Selection.Interior.ColorIndex
'récupération de la 1er couleur de fond
        If CouleurFond = CouleurCumul Then
'après comparaison des 2 couleurs on cumul
            Cells(LigneCumul, 3).Value = Cells(LigneCumul, 3).Value _
            + Cells(ligne, 1).Value
        End If
    Next ligne
Next LigneCumul
'Et on recommence
End Sub

- 2 – Dans ce second exemple nous appliquons une méthode identique mais à l'ensemble d'un tableau en comptant en plus le nombre de valeur par couleur.


Sub Cumul_Comptage_couleur()
'déclaration des variables
Dim CouleurFond As Long
Dim LigneCumul As Long
Dim CouleurCumul As Long
Dim ligne As Long
Dim col As Long
'remise à zéro de cumuls précédent sans effacement de couleur
Range("f1:f5").ClearContents
Range("h1:h5").ClearContents
For LigneCumul = 1 To 5
    Cells(LigneCumul, 6).Select
'récupération de la 1er couleur de cumul
    CouleurCumul = Selection.Interior.ColorIndex
    For ligne = 1 To 10
        For col = 1 To 4
            Cells(ligne, col).Select
            CouleurFond = Selection.Interior.ColorIndex
'récupération de la 1er couleur de fond
            If CouleurFond = CouleurCumul Then
'après comparaison des 2 couleurs on cumul
               Cells(LigneCumul, 6).Value = Cells(LigneCumul, 6).Value _
               + Cells(ligne, col).Value
' et maintenant on compte
               Cells(LigneCumul, 8).Value = Cells(LigneCumul, 8).Value + 1
              End If
        Next col
    Next ligne
Next LigneCumul
'Et on recommence
End Sub

Ces deux exemples seront aisément adaptables à vos tableaux…


 
top