Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Code VBA comptage de cellule

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
G

gerard55

XLDnaute Occasionnel
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+
 
Trier par date Trier par votes
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
 
Vote positif 0 Vote négatif
Re : Code VBA comptage de cellule

Bonsoir,

Code: 
'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+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
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+
 
Vote positif 0 Vote négatif
Re : Code VBA comptage de cellule

Re,

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

Code: 
'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+
 

Pièces jointes

Vote positif 0 Vote négatif
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+
 
Vote positif 0 Vote négatif
Re : Code VBA comptage de cellule

Re,

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

Code: 
'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 :

Code: 
=Chxcoul(F9:AD374)
Fichier (3).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
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 :

Code: 
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+
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 Erreur "l'indice n'appartient à la selection"
Réponses
10
Affichages
756
treza88
M
  • Question Question
Microsoft 365 Récupération des plages nommées des fichiers dans un répertoire
Réponses
8
Affichages
368
dysorthographie
  • Question Question
XL 2021 La méthode union de l'objet '_Global' a échoué
Réponses
10
Affichages
343
sousou
  • Résolu(e)
XL 2021 Problème réaffectation variable Objet
Réponses
2
Affichages
241
treza88
L
  • Question Question
Microsoft 365 Erreur automation 440 sur code VBA
Réponses
1
Affichages
396
job75
  • Résolu(e)
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
852
Lu76Fer
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
1 K
VBA_dev_Anne_Marie
C
  • Question Question
Microsoft 365 Comptage cellule avec condition
Réponses
2
Affichages
257
CortoXls
C
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
1 K
tnion
T
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
430
patricktoulon
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
624
anthoYS
C
  • Question Question
Microsoft 365 Supprimer ligne selon contenu cellule (résolu)
Réponses
7
Affichages
450
job75
G
  • Question Question
Autres excel vba cellule aléatoires non vides
Réponses
3
Affichages
199
danielco
D
D
  • Question Question
Microsoft 365 VBA copier cellule, conserver la copie tout en effaçant contenu
2 3
Réponses
33
Affichages
2 K
fanch55
P
  • Question Question
Microsoft 365 VBA et Segments TCD
Réponses
2
Affichages
528
patricko-13
P
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
29
Affichages
2 K
TooFatBoy
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
427
Pierreavecunp
P
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
482
nabilexcel2007
N
  • Question Question
XL 2016 annulation ou désactivation de macro
2
Réponses
27
Affichages
1 K
job75
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
915
TooFatBoy
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…