Discussion :

[jekeclo]

bonjour à tous,

j'utilise la fonction NB.Si lorsqu'il y a des valeurs dans la cellules mais je ne pense pas pouvoir l'utiliser dans ce cas,

j'ai une colonne ou chaque cellule prend une couleur différente (blanc, orange, verte, rouge) en fonction d'événement,

j'aimerais récupérer dans une cellule sur une autre feuille le nombre de cellule avec la couleur orange, verte et rouge

Quelqu'un aurait un bout de code, merci de votre aide

[conconbrr]

Tiens je te file un exemple issu de mon projet en cours

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Effacer_RemplissageJaune()
    Dim cfFormatCelluleDepart As CellFormat
    Dim cfFormatCelluleArrivee As CellFormat
    Dim rgRecherche As Range
    Set cfFormatCelluleDepart = Application.FindFormat
    Set cfFormatCelluleArrivee = Application.ReplaceFormat
 
    cfFormatCelluleDepart.Clear
    cfFormatCelluleDepart.Interior.ColorIndex = 6
    cfFormatCelluleArrivee.Clear
    cfFormatCelluleArrivee.Interior.ColorIndex = 2
 
    Set rgRecherche = Range("m:o").Find(what:="", searchformat:=True)
    If Not rgRecherche Is Nothing Then
        Range("m:o").Replace what:="", replacement:="", searchformat:=True, ReplaceFormat:=True
    End If
 
    cfFormatCelluleDepart.Clear
    cfFormatCelluleArrivee.Clear
 
End Sub

Tu devrais pas avoir trop de mal à comprendre et à adpater... En gros tu cherches le format avec findformat.
Si tu souhaitais le remplacer par un autre tu utilserais replaceformat

Mon bout de code permet de remplacer tous les formats définis mais si tu fais find à la place de replace tu n'auras que le premier.

Tu dois donc faire une boucle while dans le quel tu utiliseras findnext. Rajoutes-y un compteur et une condition de sortie lorsque ton findnext vaut Nothing
Voilà le tour est joué

[jekeclo]

merci bien pour la réponse

A+

[SilkyRoad]

bonjour

ci joint une autre possiblité
il restera à adapter les codes couleurs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub compteurCouleursCellules()
    Dim Cell As Range
 
    Feuil2.Range("A1:A10").Clear
 
    'recherche dans la plage A1:A10 de la Feuil1
    'Le résultat s'affiche dans la Feuil2
    For Each Cell In Feuil1.Range("A1:A10")
        Select Case Cell.Interior.ColorIndex
            'sans couleur
            Case xlNone: Feuil2.Cells(1, 1) = Feuil2.Cells(1, 1) + 1
            'orange
            Case 46: Feuil2.Cells(2, 1) = Feuil2.Cells(2, 1) + 1
            'vert
            Case 10: Feuil2.Cells(3, 1) = Feuil2.Cells(3, 1) + 1
            'rouge
            Case 3: Feuil2.Cells(4, 1) = Feuil2.Cells(4, 1) + 1
        End Select
    Next Cell
 
Feuil2.Cells(1, 1).Interior.ColorIndex = xlNone
Feuil2.Cells(2, 1).Interior.ColorIndex = 46
Feuil2.Cells(3, 1).Interior.ColorIndex = 10
Feuil2.Cells(4, 1).Interior.ColorIndex = 3
End Sub

bonne journée
michel

[conconbrr]

Ceci dit je pense que le find et replace sont plus rapides que de parcourir les cellules.

Enfin en tout cas si tu en as plus de deux ou trois...

Tu confirmes michel?

EDIT:Cette remarque a simplement pour but l'optimisation d'une méthode

[SilkyRoad]

rebonjour

j'ai interprété (peut etre à tort) que Jekeclo souhaitait boucler sur toutes les cellules pour compter les couleurs...


bonne soiree
michel

[conconbrr]

Non non je crois que c'est bien ça. C'est pour ça que je posais la question. Le findenext est-il plus rapide que de tester chaque cellule??

Il me semblait que oui mais peut être que je me trompe?