XL 2016 Compter les cellules avec des critères

Rabeto · 19 Mars 2022

Bonjour,

Quelqu'un peut m'aider à résoudre ce problématique svp,

Je souhaite compter le nombre de cellule par colonne contenant des critères différents de l'alphabet (sauf avec accent) et des chiffres (0 à 9) (ne pas compter les espaces vides sauf s'il y a double espace entre 2 valeurs)
Puis colorier ces cellules par une MFC (rouge par exemple) et mettre le nombre des cellules contenants ces critères en haut de chaque colonne.

Merci,

job75 · 19 Mars 2022

Bonsoir Robert,

Il vaut mieux créer la MFC et utiliser VBA pour faire le comptage en A1 B1 C1 :

VB:

Private Sub Worksheet_Change(ByVal target As Range)
Dim ncol%, a&(), col%, c As Range
ncol = 3 'nombre de colonnes, à adapter
ReDim a(1 To ncol)
For col = 1 To ncol
    For Each c In UsedRange.Columns(col).Cells
        If c <> "" Then If c.DisplayFormat.Interior.Color = vbRed Then a(col) = a(col) + 1
Next c, col
'---restitution---
Application.EnableEvents = False 'désactive les évènements
[A1].Resize(, ncol) = a
Application.EnableEvents = True 'réactive les évènements
End Sub

La macro se déclenche quand on modifie ou valide une cellule quelconque.

A+

job75 · 24 Mars 2022

J'ai refait ce post.

Dans ce fichier (4) la plage des 4 critères nommée Liste est un vecteur colonne Z2:Z5.

Le nombre de critères peut être augmenté.

La MFC sur la plage A3:X5007 est définie par cette formule très simple :

Code:

=OU((Liste<>"")*ESTNUM(TROUVE(Liste;A3)))

C'est une formule matricielle mais qui bien sûr ne nécessite pas de validation spéciale.

Le comptage pour chaque colonne est assuré par cette fonction VBA :

VB:

Function Compte(r As Range)
'r et Liste sont des vecteurs colonnes
Dim interdit, ub%, tablo, i&, x$, j%, y$
interdit = [Liste].Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ub = UBound(interdit)
tablo = r.Resize(r.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments)
For i = 1 To UBound(tablo) - 1
    x = tablo(i, 1)
    For j = 1 To ub
        y = interdit(j, 1)
        If y <> "" Then If InStr(x, y) Then Compte = Compte + 1: Exit For
Next j, i
End Function

Elle est très rapide, le calcul des 24 formules en ligne 1 s'effectue chez moi en 0,12 seconde.

XL 2016 Compter les cellules avec des critères

Rabeto

XLDnaute Occasionnel

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires