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
'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
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…
0 commentaires:
Enregistrer un commentaire