Code VBA comptage de cellule

[gerard55]

Bonjour à tous,
je souhaite modifier ce code afin de pouvoir compter les cellules colorés par ligne et non par colonne.
Function Chxcoul()
Application.Volatile
Set c = Application.Caller
For Each cel In Range(c(2, 1), Cells(65536, c.Column).End(xlUp))
If cel.Interior.ColorIndex = c.Interior.ColorIndex Then Chxcoul = Chxcoul + 1
Next
c = Chxcoul
End Function
Si quelqu'un peut me donner le conseil, merci d'avance.
a+

 

[brunosc]

Re : Code VBA comptage de cellule

A tester :
Function SommeCouleurFond(champ As Range, couleurFond)
Application.Volatile
Dim c, temp
temp = 0
For Each c In champ
If c.Interior.ColorIndex = couleurFond Then
If IsNumeric(c.Value) Then temp = temp + c.Value
End If
Next c
SommeCouleurFond = temp
End Function

Formules a mettre dans la cellule:
=sommecouleurfond($H$2:$H$87;3)
Bonne soirée

 

[job75]

Re : Code VBA comptage de cellule

Bonsoir,

'Nombre de cellules de même couleur que Application.Caller
'et situées sous Application.Caller

Function Chxcoul&()
Dim c As Range, cel As Range
Application.Volatile
Set c = Application.Caller
For Each cel In Intersect(c.Parent.UsedRange, c.Resize(65537 - c.Row))
If cel.Interior.ColorIndex = c.Interior.ColorIndex Then Chxcoul = Chxcoul + 1
Next
Chxcoul = Chxcoul - 1 'on ne compte pas Application.Caller
End Function

Edit : joindre un fichier c'est quand même mieux...

A+

 

[brunosc]

Re : Code VBA comptage de cellule

Salut, pas mal je la met de coté celle la
@+

 

[job75]

Re : Code VBA comptage de cellule

Bonjour,

Ma macro n'est pas mal surtout parce qu'elle "colle" avec ce que veut faire gerard55...

A+

 

[gerard55]

Re : Code VBA comptage de cellule

Merci pour vos suggestions.
Brunosc, la formule que vous proposez ne me renvoi aucun résulat. Job75 Le code fonctionne mais il compte les cellules coloriées sur les colonnes. Mais, je voudrais la même chose sur la ligne (365 lignes)
a+

 

[job75]

Re : Code VBA comptage de cellule

Re,

Alors la même chose à droite de Application.Caller :

'Nombre de cellules de même couleur que Application.Caller
'et situées à droite de Application.Caller

Function Chxcoul&()
Dim c As Range, cel As Range
Application.Volatile
Set c = Application.Caller
For Each cel In Intersect(c.Parent.UsedRange, c.Resize(, 257 - c.Column))
If cel.Interior.ColorIndex = c.Interior.ColorIndex Then Chxcoul = Chxcoul + 1
Next
Chxcoul = Chxcoul - 1 'on ne compte pas Application.Caller
End Function

Et tirez la cellule B4 vers le bas...

Fichier (2).

A+

 

[gerard55]

Re : Code VBA comptage de cellule

Merci beaucoup job75. ça fonctionne très bien. Mais moi, ma recherche est à droite en AF pour une zone de recherche F9:AD374.
J'ai essayé de modifier la ligne ci- dessous mais en vain
(, 257 - c.Column))
Si vous avez la bonne syntaxe merci d'avance
a+

 

[job75]

Re : Code VBA comptage de cellule

Re,

Dans ce cas le plus simple est d'introduire le paramètre plage dans la fonction :

'Nombre de cellules de même couleur que Application.Caller
'et situées dans plage

Function Chxcoul&(plage As Range)
Dim c As Range, cel As Range
Application.Volatile
Set c = Application.Caller
For Each cel In Intersect(c.Parent.UsedRange, plage)
If cel.Interior.ColorIndex = c.Interior.ColorIndex Then Chxcoul = Chxcoul + 1
Next
End Function

Maintenant si Application.Caller est dans plage elle sera comptée.

Formule en B9 :

=Chxcoul(F9:AD374)

Fichier (3).

A+

 

[job75]

Re : Code VBA comptage de cellule

Re,

2 remarques encore :

1) Application.Caller pourrait être dans une autre feuille que plage

2) plage pourrait être en dehors du UsedRange.

Alors, pour éviter que la fonction renvoie une valeur d'erreur, utiliser :

Function Chxcoul&(plage As Range)
Dim c As Range, cel As Range
Application.Volatile
On Error Resume Next
Set c = Application.Caller
For Each cel In Intersect(plage.Parent.UsedRange, plage)
If cel.Interior.ColorIndex = c.Interior.ColorIndex Then Chxcoul = Chxcoul + 1
Next
If Err Then Chxcoul = 0
End Function

Fichier (4).

A+