Filtrer en fonction des couleurs Fermé

Question

Bonjour, à toutes et tous 
Je voudrais filtrer les lignes d'un tableau en fonction de la couleur des cellules du tableau . 
j'arrive à le faire en utilisant la boucle for each sur un petit tableau
Sub jaune() Application.ScreenUpdating = FalseDim MyCell As RangeSheets("donnees").Range("$C$8:$X$76").EntireRow.Hidden = True    For Each MyCell In Sheets("donnees").Range("$C$8:$X$76") If MyCell.Interior.ColorIndex = Sheets("donnees").Range("c1").Interior.ColorIndex Then         MyCell.EntireRow.Hidden = False        End If       Next MyCell        Application.ScreenUpdating = TrueEnd Sub

Sub rouge() Application.ScreenUpdating = FalseDim MyCell As RangeSheets("donnees").Range("$C$8:$X$76").EntireRow.Hidden = True         For Each MyCell In Sheets("donnees").Range("$C$8:$X$76") If MyCell.Interior.ColorIndex = Sheets("donnees").Range("d1").Interior.ColorIndex Then         MyCell.EntireRow.Hidden = False        End If       Next MyCell        Application.ScreenUpdating = TrueEnd Sub************************************************************Sub vert() Application.ScreenUpdating = FalseDim MyCell As RangeSheets("donnees").Range("$C$8:$X$76").EntireRow.Hidden = True         For Each MyCell In Sheets("donnees").Range("$C$8:$X$76") If MyCell.Interior.ColorIndex = Sheets("donnees").Range("e1").Interior.ColorIndex Then         MyCell.EntireRow.Hidden = False        End If       Next MyCell        Application.ScreenUpdating = TrueEnd SubSeulement les choses se gatent sur mon tableau d'environ 1500 colonnes et 800 lignes
C'est ultra lent. 
Auriez vous une idée plus rapide pour filtrer les lignes à me proposer?
ci joint le fichier 
http://www.cjoint.com/c/FLmkx65RAXA
Merci de votre aide
Configuration: Windows 7 / Safari 5.1.7

eriiic · Answer

Bonjour,
à voir si c'est mieux :
Sub jaune()
    filtrer [C1].Interior.Color
End Sub

Sub rouge()
    filtrer [D1].Interior.Color
End Sub

Sub vert()
    filtrer [E1].Interior.Color
End Sub

Sub filtrer(couleur As Long)
    Dim pl As Range, lig As Long, col As Long

Application.ScreenUpdating = False
    Set pl = Sheets("donnees").Range("$C$8:$X$76")
    pl.EntireRow.Hidden = True
    For lig = pl.Row To pl.Row + pl.Rows.Count
        For col = pl.Column To pl.Column + pl.Columns.Count
            If Cells(lig, col).Interior.Color = couleur Then
                Rows(lig).EntireRow.Hidden = False
                Exit For
            End If
        Next col
    Next lig
End Sub 
Le plus efficace serait d'avoir des valeurs dans ces cellules et une colonne de synthèse pour filtrer directement dessus.
eric

julia Namor · Answer

Bonjour Eric
Je gagne pas mal de temps en traitement . 
Les couleurs du filtre se trouvent dans une autre feuille ("Base").
J'ai transformé  comme tel 
Sub ma_jaune()    filtrer [Sheets(Base").Range("c1")].Interior.ColorEnd SubSub ma_rouge()    filtrer [Sheets("Base").Range("d1")].Interior.ColorEnd SubSub ma_vert()    filtrer [Sheets("Base").Range("e1")].Interior.ColorEnd Sub
j'obtiens une erreur. 
"Le plus efficace serait d'avoir des valeurs dans ces cellules et une colonne de synthèse pour filtrer directement dessus. 
En fait il ya des valeurs et des commentaires dans la majorité des cellules .Certaines sont vides . Mais j'ai vraiment besoin de filtrer en fonction de la  couleur pour les affectations .
Merci eric

julia Namor · Answer

Bonjour 
--Les boutons fonctionnent bien chez moi. 
Ferme et relance excel pour voir.
Si j'ai bien compris le fonctionnement du filtre : Il faut d'abord cliquer sur le bouton "FILTRE JAUNE " ou .... Là toutes les lignes sont masquées puis je selection le filtre "vrai" dans la colonne C. 
Le resultat s'obtient en deux temps. 
mais comme tu me le conseilles ,je vais rester sur l'ancienne version
--Ce qui prend du temps c'est de lire la couleur des cellules une par une
Est ce qu'au lieu de lire les cellulles une à une , ce serait possible pour la macro: Dans la plage spécifiée
-- de touver uniquement  la toute premiere cellule de la ligne contenant la couleur du filtre 
-- d'afficher cette ligne ou ne pas la masquer
-- D'aller aussitot à la ligne suivante pour refaire la meme procédure. 
Ainsi on gagnerait en temps de traitement du fait que toutes les cellules de la plage ne sont pas lues. 
J'espere que c'est réalisable 
Merci Beaucoup

julia Namor · Answer

En fait ma demande ci- dessus était déja satisfaite par ton code 
je viens de m'en rendre compte 
Sub filtrer1(couleur As Long)    Dim pl As Range, lig As Long, col As Long    Application.ScreenUpdating = False    Set pl = Sheets("donnees").Range("$C$8:$X$76")    pl.EntireRow.Hidden = True    For lig = pl.Row To pl.Row + pl.Rows.Count        For col = pl.Column To pl.Column + pl.Columns.Count            If Cells(lig, col).Interior.Color = couleur Then            MsgBox "J'ai trouvé une cellule jaune : " & Cells(lig, col).Address                Rows(lig).EntireRow.Hidden = False                Exit For            End If        Next col    Next ligEnd Sub
Merci beaucoup

Filtrer en fonction des couleurs

4 réponses

Discussions similaires