VBA Afficher/Masquer cellules selon leur couleur

Résolu
Bonjour,

comment on fait ( macro / VBA ), dans une feuille avec plusieurs cellules de différentes couleurs de n'afficher / masquer que les cellules dont la couleur nous intérésse ?

Merci

9 réponses

  1. Bonjour ,

    je reviens vers vous pour savoir comment adapter le code que vous m'avez passé hier afi nde pouvoir filtrer des colonnes

    Sub Filtrer(Coul As Integer)
    Dim lig As Integer, col As Integer, Masque As Boolean

    For lig = 5 To 34
    Masque = True
    For col = 3 To 59
    If Cells(lig, col).Interior.ColorIndex = Coul Then Masque = False
    Next col
    If Masque = True Then Rows(lig).Hidden = True
    Next lig
    End Sub

    Merci d'avance

    cordialement
    0
    1. Modérateur
      Bonjour,

      Simplement.
      Tu détermines tes cellules en fonction de deux critères : la ligne (variable lig) et la colonne (variable col).
      Si tu veux masquer la colonne au lieu de la ligne, il convient de remplacer: Rows(machin) par Columns(truc)
      Par contre, comme nous avons une double boucle, d'abord sur les lignes puis sur les colonnes, il nous faudra les inverser...
      Résultat
      Sub Filtrer(Coul As Integer) 
      Dim lig As Integer, col As Integer, Masque As Boolean 
      
      For col = 3 To 59
          Masque = True
          For lig = 5 To 34 
              If Cells(lig, col).Interior.ColorIndex = Coul Then Masque = False 
          Next lig
          If Masque = True Then Columns(col).Hidden = True 
      Next col
      End Sub
      0
  2. Merci beaucoup , ça m'a beaucoup aidé
    0
    1. Modérateur
      De rien.
      A+
      0
  3. et pour répondre à votre question , c'est oui !
    0
    1. voilà le lien à une partie du tableau ,
      le filtre que vous m'avez proposé se fait sur la ligne , ce qui fait , j'ai des cellules sur la même ligne faisant référence à d'autre entreprises qui restent affichées

      https://www.cjoint.com/?3DyovIC4xXH
      0
      1. Modérateur
        En fait, un filtre s'applique soit sur toute la ligne, soit sur toute la colonne...

        Si tu veux n'obtenir que tes cellules rouges, il faut les copier/coller sur une autre Feuille par exemple...
        Je te fais ça sur mon classeur exemple.
        0
      2. Modérateur
        premier exemple :
        Sub FiltreSurCouleur()
        If ActiveCell.Interior.ColorIndex = xlNone Then MsgBox "Merci de sélectionner une cellule colorée pour le filtre.": Exit Sub
        Filtrer ActiveCell.Interior.ColorIndex
        End Sub
        
        Sub Filtrer(coul As Integer)
        Dim lig As Integer, col As Integer, ligF2 As Integer, colF2 As Integer
        
        With Sheets("Feuil2")
            For lig = 5 To 23 'de la ligne 5 à la ligne 23
                For col = 3 To 59 ' de la colonne C à BF
                    If Sheets("Feuil1").Cells(lig, col).Interior.ColorIndex = coul Then Sheets("Feuil1").Cells(lig, col).Copy .Cells(lig, col)
                Next col
            Next lig
            .Activate
        End With
        End Sub
        0
    2. Modérateur
      filtrer les cellules de même couleur, pas toute la ligne
      Je ne comprends pas...
      Prenons un exemple.
      Tu as, dans ton Range("C5:BF23") 5 cellules rouge (colorindex = 3) situées en : C18, G5, AZ23, BA5 et BA6. Tu ne veux avoir affiché à l'écran que ces 5 cellules???
      0
      1. Merci énormélement,
        je suis entrain de travailler dessus
        0
        1. Modérateur
          N'hésite pas à revenir si cela fonctionne ... ou pas!
          0
        2. j'ai essayé , votre programme marche super bien , sauf que moi j'ai besoin de filtrer les cellules de même couleur, pas toute la ligne
          0
      2. Modérateur
        Bon, voici ma proposition :

        Un classeur exemple.

        Dans le module de la feuille concernée :
        La macro de coloriage de cellules au clic dans une cellule :
        Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
        Dim Texte As String, NomsEntreprises As Variant, i As Integer 
        
        If Target.Count > 1 Then Exit Sub 
        NomsEntreprises = RempliEntreprises 
        Texte = "" 
        For i = LBound(NomsEntreprises) To UBound(NomsEntreprises) 
            If InStr(Target.Value, NomsEntreprises(i)) Then Texte = NomsEntreprises(i): Exit For 
        Next i 
        If Texte <> "" And Not IsError(Application.Match(Texte, RempliEntreprises, 0)) Then Range(Target, Target.Offset(0, 1)).Interior.ColorIndex = Colorer(Texte) 
        End Sub

        Pour que cette macro fonctionne, il faut placer ces trois fonctions dans un module standard :
        Function RempliCouleurs() As Variant 
        RempliCouleurs = Array(36, 10, 3, 37, 24, 40, 7, 46, 43, 27, 22, 39, 8) 
        End Function 
        
        'A ADAPTER : 
        'les noms des entreprises ci-dessous, 
        'dans le même ordre que les couleurs ci-dessus 
        
        Function RempliEntreprises() As Variant 
        RempliEntreprises = Array("Renault", "Peugeot", "Citroën", "Fiat", "Ferrari", "Porsche", "Lada", "Seat", "Wolksvagen", "Honda", "BMW", "Mercedes", "Ford") 
        End Function 
        
        Function Colorer(Entreprise) 
        Colorer = RempliCouleurs(Application.Match(Entreprise, RempliEntreprises, 0) - 1) 
        End Function


        La macro qui filtre comprends deux procédures, les placer dans un module standard également (le même) :
        Sub FiltreSurCouleur() 
        If ActiveCell.Interior.ColorIndex = xlNone Then MsgBox "Merci de sélectionner une cellule colorée pour le filtre.": Exit Sub 
        Range("C5:BF23").EntireRow.Hidden = False 
        Filtrer ActiveCell.Interior.ColorIndex 
        End Sub 
        
        Sub Filtrer(Coul As Integer) 
        Dim lig As Integer, col As Integer, Masque As Boolean 
        
        For lig = 5 To 23 'de la ligne 5 à la ligne 23 
            Masque = True 
            For col = 3 To 59 ' de la colonne C à BF 
                If Cells(lig, col).Interior.ColorIndex = Coul Then Masque = False 
            Next col 
            If Masque = True Then Rows(lig).Hidden = True 
        Next lig 
        End Sub

        pour filtrer, sélectionner un cellule de la couleur voulue et lancer la macro FiltreSurCouleur...

        En bonus, cette procédure colorie toutes les cellules de C5 à BF23 qui contiennent une des entreprises...
        Sub ColorieToutLeRangeC5BF23() 
        Dim Cel As Range, Cpt As Integer, Texte As String, NomsEntreprises As Variant, i As Integer 
        
        NomsEntreprises = RempliEntreprises 
        For Each Cel In Range("C5:BF23") 
            Texte = "" 
            For i = LBound(NomsEntreprises) To UBound(NomsEntreprises) 
                If InStr(Cel.Value, NomsEntreprises(i)) Then Texte = NomsEntreprises(i): Exit For 
            Next i 
            If Texte <> "" And Not IsError(Application.Match(Texte, RempliEntreprises, 0)) Then Range(Cel, Cel.Offset(0, 1)).Interior.ColorIndex = Colorer(Texte) 
        Next Cel 
        End Sub


        Cordialement,
        Franck P
        -1
        1. Re-bonjour

          Les couleurs dans la cellules sont obtenus en fonction d'"un mot" figurant dans la cellule à l'aide de :
          Private Sub worksheet_selectionchange(ByVal target As Range)
          ligne = ActiveCell.Row
          colonne = ActiveCell.Column
          If InStr(Cells(ligne, colonne), "Entreprise1 ") Then
          Cells(ligne, colonne).Interior.ColorIndex = 36
          Cells(ligne, colonne + 1).Interior.ColorIndex = 36
          End If
          end sub

          et j'ai plus de 15 couleurs ( 15 entreprises )
          lignes concernées sont : 5 à 23
          colonnes concernées : C à BF

          Merci d'avance
          0
          1. Modérateur
            Tu dis :
            j'ai plus de 15 couleurs ( 15 entreprises )
            Or, dans le code que tu nous donnes, je ne vois qu'une entreprise et une couleur.
            Peux tu, stp, nous donner le code entier?
            0
          2. comme c'est le même code je voulais éviter de vous copier toute la page
            le voila :
            Private Sub worksheet_selectionchange(ByVal target As Range)
            ligne = ActiveCell.Row
            colonne = ActiveCell.Column
            If InStr(Cells(ligne, colonne), "entreprise 1") Then
            Cells(ligne, colonne).Interior.ColorIndex = 36
            Cells(ligne, colonne + 1).Interior.ColorIndex = 36
            End If
            If InStr(Cells(ligne, colonne), "entreprise 2") Then
            Cells(ligne, colonne).Interior.ColorIndex = 10
            Cells(ligne, colonne + 1).Interior.ColorIndex = 10
            End If
            If InStr(Cells(ligne, colonne), "entreprise 3") Then
            Cells(ligne, colonne).Interior.ColorIndex = 3
            Cells(ligne, colonne + 1).Interior.ColorIndex = 3
            End If
            If InStr(Cells(ligne, colonne), "entreprise 4") Then
            Cells(ligne, colonne).Interior.ColorIndex = 37
            Cells(ligne, colonne + 1).Interior.ColorIndex = 37
            End If
            If InStr(Cells(ligne, colonne), "entreprise 5")Then
            Cells(ligne, colonne).Interior.ColorIndex = 24
            Cells(ligne, colonne + 1).Interior.ColorIndex = 24
            End If
            If InStr(Cells(ligne, colonne), "entreprise 6") Then
            Cells(ligne, colonne).Interior.ColorIndex = 40
            Cells(ligne, colonne + 1).Interior.ColorIndex = 40
            End If
            If InStr(Cells(ligne, colonne), "entreprise 7") Then
            Cells(ligne, colonne).Interior.ColorIndex = 7
            Cells(ligne, colonne + 1).Interior.ColorIndex = 7
            End If
            If InStr(Cells(ligne, colonne), "entreprise 8") Then
            Cells(ligne, colonne).Interior.ColorIndex = 46
            Cells(ligne, colonne + 1).Interior.ColorIndex = 46
            End If
            If InStr(Cells(ligne, colonne), "entreprise 9") Then
            Cells(ligne, colonne).Interior.ColorIndex = 43
            Cells(ligne, colonne + 1).Interior.ColorIndex = 43
            End If
            If InStr(Cells(ligne, colonne), "entreprise 10") Then
            Cells(ligne, colonne).Interior.ColorIndex = 27
            Cells(ligne, colonne + 1).Interior.ColorIndex = 27
            End If
            If InStr(Cells(ligne, colonne), "entreprise 11") Then
            Cells(ligne, colonne).Interior.ColorIndex = 22
            Cells(ligne, colonne + 1).Interior.ColorIndex = 22
            End If
            If InStr(Cells(ligne, colonne), "entreprise 12") Then
            Cells(ligne, colonne).Interior.ColorIndex = 39
            Cells(ligne, colonne + 1).Interior.ColorIndex = 39
            End If
            If InStr(Cells(ligne, colonne), "entreprise 13") Then
            Cells(ligne, colonne).Interior.ColorIndex = 8
            Cells(ligne, colonne + 1).Interior.ColorIndex = 8
            End If

            End Sub
            0
          3. Modérateur
            ok. C'était nécessaire pour avoir les codes couleurs.
            Je regarde pour :
            1- modifier ton code qui est énorme
            2- te faire un système d'affichage / masquage.
            Réponse dans la mâtinée.
            0
          4. Modérateur
            Question subsidiaire :
            Les cellules ou sont tes noms d'entreprises sont toutes dans la même colonne? ColonneB? C?
            0
          5. non elle vont des collones "C" à " BF "
            0
        2. Modérateur
          Bonjour,

          Inutile de doublonner, nous allons te répondre ici.

          Comment sont obtenues les couleurs dans ta feuille? Mise en forme conditionnelle ou saisies par l'utilisateur?
          Qu'elles sont les lignes et colonnes concernées?
          1