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. 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
    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. 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
    3. 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. 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. et pour répondre à votre question , c'est oui !
        0
        1. Merci beaucoup , ça m'a beaucoup aidé
          0
          1. Modérateur
            De rien.
            A+
            0
        2. 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
        3. 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