VBA Afficher/Masquer cellules selon leur couleur
Résolu/Fermé
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
-
Modifié par pijaku le 23/04/2013 à 17:13
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 25 avril 2013 à 10:24
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 25 avril 2013 à 10:24
A voir également:
- VBA Afficher/Masquer cellules selon leur couleur
- Excel cellule couleur si condition texte - Guide
- Formule excel pour additionner plusieurs cellules - Guide
- Excel compter cellule couleur sans vba - Guide
- Masquer conversation whatsapp - Guide
- Verrouiller cellules excel - Guide
9 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 09:53
24 avril 2013 à 09:53
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?
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?
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 09:57
24 avril 2013 à 09:57
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 10:03
24 avril 2013 à 10:03
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?
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?
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 10:06
24 avril 2013 à 10:06
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 10:08
24 avril 2013 à 10:08
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.
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.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 10:09
24 avril 2013 à 10:09
Question subsidiaire :
Les cellules ou sont tes noms d'entreprises sont toutes dans la même colonne? ColonneB? C?
Les cellules ou sont tes noms d'entreprises sont toutes dans la même colonne? ColonneB? C?
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 10:12
24 avril 2013 à 10:12
non elle vont des collones "C" à " BF "
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 13:44
24 avril 2013 à 13:44
Merci énormélement,
je suis entrain de travailler dessus
je suis entrain de travailler dessus
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 13:54
24 avril 2013 à 13:54
N'hésite pas à revenir si cela fonctionne ... ou pas!
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 14:01
24 avril 2013 à 14:01
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 14:18
24 avril 2013 à 14:18
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???
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???
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 14:23
24 avril 2013 à 14:23
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 14:29
24 avril 2013 à 14:29
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.
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.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 14:41
24 avril 2013 à 14:41
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
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 14:24
24 avril 2013 à 14:24
et pour répondre à votre question , c'est oui !
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
24 avril 2013 à 15:39
24 avril 2013 à 15:39
Merci beaucoup , ça m'a beaucoup aidé
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
24 avril 2013 à 15:53
24 avril 2013 à 15:53
De rien.
A+
A+
bkssm5589
Messages postés
15
Date d'inscription
mardi 23 avril 2013
Statut
Membre
Dernière intervention
25 avril 2013
25 avril 2013 à 10:12
25 avril 2013 à 10:12
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
25 avril 2013 à 10:24
25 avril 2013 à 10:24
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 751
Modifié par pijaku le 24/04/2013 à 12:10
Modifié par pijaku le 24/04/2013 à 12:10
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 :
Pour que cette macro fonctionne, il faut placer ces trois fonctions dans un module standard :
La macro qui filtre comprends deux procédures, les placer dans un module standard également (le même) :
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...
Cordialement,
Franck P
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