Tri par couleur

Le
suze32
Bonjour à tous,

J'ai déjà posé un post ce matin, mais je me suit mal expliqué don j=
e
réitère ma demande.

J'ai une base de donnée ou j'ai coloré des lignes entières par type,
et j'aimerai avoir une macro ou une fonction me permettant de faire un
tri de mes cellules par couleurs.

Je vous remercie de vos réponses, bonne aprèm
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19891051
Bonjour Suze32,

Si tu as une version Excel 2007, tu peux appeler la commande
"Tri personnalisé" et effectuer un tri sur la couleur de la police
ou la couleur de fond des cellules.

Pour les autres versions, il te faudra créer une fonction personnalisée
comme celle-ci pour la couleur de fond des cellules :

Module standard :
Function Tri_Couleur(Rg As Range)
'Couleur de fond de la cellule
Tri_Couleur = Rg.Interior.ColorIndex
'Couleur du texte de la cellule
'Tri_Couleur = Rg.Interior.Font.ColorIndex
End Function

Tu ajoutes une colonne et tu inscris : =Tri_Couleur(A1)
formule que tu recopies pour toute la colonne.

Tu sélectionnes tout ton tableau, et tu effectues ton tri
sur la colonne affichant le résultat de la formule.

Tu peux effectuer la même chose pour un filtre automatique.



"suze32"
Bonjour à tous,

J'ai déjà posé un post ce matin, mais je me suit mal expliqué don je
réitère ma demande.

J'ai une base de donnée ou j'ai coloré des lignes entières par type,
et j'aimerai avoir une macro ou une fonction me permettant de faire un
tri de mes cellules par couleurs.

Je vous remercie de vos réponses, bonne aprèm
milloche
Le #19891041
Bonjour
Cette question revient souvent.
J'ai bidouillé un truc (à adapter à ton fichier) qui fonctionne chez moi.
Mais je ne suis pas répondeur ici. Et je ne serais pas capable de l'adapter
à ton cas.
Si tu touche un peu le VBA, tu comprendras le principe.
Bonne chance.

Sub FiltreCouleur()
Dim couleur, colonne, position
Set position = ActiveCell
If ActiveCell.Row < 3 Then [a65536].End(xlUp).Select: Exit Sub
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
If ActiveSheet.DrawingObjects("BoutCoul").Caption = "FILTRE COULEUR" Then
ActiveSheet.DrawingObjects("BoutCoul").Caption = "FILTRER COULEUR"
ActiveSheet.DrawingObjects("BoutCoul").ShapeRange.Fill.ForeColor.SchemeColor
= 22
Range("A2").AutoFilter field:=5, Criteria1:="<>"""""
ActiveWindow.FreezePanes = False
Application.Goto Reference:="R3C2"
ActiveWindow.FreezePanes = True
[a65536].End(xlUp).Select
Range("O1").FormulaLocal = "=N1/U1"
Range("Q1").FormulaLocal = "=P1/U1"
Range("C2") = "Nbre"
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveCell.Select
Application.Calculation = xlAutomatic
Exit Sub
End If
colonne = ActiveCell.Column
couleur = ActiveCell.Interior.ColorIndex
Application.ScreenUpdating = False
Range("A65536").End(xlUp).Offset(0, colonne - 1).Select
If couleur > 0 Then
Range("O1") = "=N1/I1": Range("Q1") = "=P1/G1": Range("S1") = "Sur I"
ActiveSheet.DrawingObjects("BoutCoul").ShapeRange.Fill.ForeColor.SchemeColor
= couleur + 7 '3 'vert
Else
Range("O1") = "=N1/U1": Range("Q1") = "=P1/U1": Range("S1") = "Sur U"
ActiveSheet.DrawingObjects("BoutCoul").ShapeRange.Fill.ForeColor.SchemeColor
= 9
End If
ActiveSheet.DrawingObjects("BoutCoul").Caption = "FILTRE COULEUR"
Do
If ActiveCell.Interior.ColorIndex = couleur Then
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Row = 2 Then
Application.ScreenUpdating = True
[a65536].End(xlUp).Select
position.Select
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Exit Sub
End If
Else
ActiveCell.EntireRow.Hidden = True
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Row = 2 Then
Application.ScreenUpdating = True
position.Select
Exit Do
End If
End If
Loop
Application.ScreenUpdating = True
ActiveWindow.LargeScroll Down:=-5
Application.EnableEvents = True
Range("O1").FormulaLocal = "=N1/I1"
Range("Q1").FormulaLocal = "=P1/G1"
position.Select
'Range("C2").FormulaR1C1 = "ÊlcSpe(R3C:R[65000]C)"
Application.Calculation = xlCalculationAutomatic
End Sub

"suze32"
Bonjour à tous,

J'ai déjà posé un post ce matin, mais je me suit mal expliqué don je
réitère ma demande.

J'ai une base de donnée ou j'ai coloré des lignes entières par type,
et j'aimerai avoir une macro ou une fonction me permettant de faire un
tri de mes cellules par couleurs.

Je vous remercie de vos réponses, bonne aprèm
MichDenis
Le #19891031
OUPS, à la fonction personnalisée, ajoute
une ligne de code sous la ligne de déclaration :

Application.Volatile
milloche
Le #19891101
J'ai mal saisi le problème.
Tu parles de tri et moi je parle de filtre.
Fais comme si j'avais rien dit.

"milloche" %
Bonjour
Cette question revient souvent.
J'ai bidouillé un truc (à adapter à ton fichier) qui fonctionne chez moi.
Mais je ne suis pas répondeur ici. Et je ne serais pas capable de
l'adapter à ton cas.
Si tu touche un peu le VBA, tu comprendras le principe.
Bonne chance.

Sub FiltreCouleur()
Dim couleur, colonne, position
Set position = ActiveCell
If ActiveCell.Row < 3 Then [a65536].End(xlUp).Select: Exit Sub
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
If ActiveSheet.DrawingObjects("BoutCoul").Caption = "FILTRE COULEUR" Then
ActiveSheet.DrawingObjects("BoutCoul").Caption = "FILTRER COULEUR"

ActiveSheet.DrawingObjects("BoutCoul").ShapeRange.Fill.ForeColor.SchemeColor
= 22
Range("A2").AutoFilter field:=5, Criteria1:="<>"""""
ActiveWindow.FreezePanes = False
Application.Goto Reference:="R3C2"
ActiveWindow.FreezePanes = True
[a65536].End(xlUp).Select
Range("O1").FormulaLocal = "=N1/U1"
Range("Q1").FormulaLocal = "=P1/U1"
Range("C2") = "Nbre"
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveCell.Select
Application.Calculation = xlAutomatic
Exit Sub
End If
colonne = ActiveCell.Column
couleur = ActiveCell.Interior.ColorIndex
Application.ScreenUpdating = False
Range("A65536").End(xlUp).Offset(0, colonne - 1).Select
If couleur > 0 Then
Range("O1") = "=N1/I1": Range("Q1") = "=P1/G1": Range("S1") = "Sur I"
ActiveSheet.DrawingObjects("BoutCoul").ShapeRange.Fill.ForeColor.SchemeColor
= couleur + 7 '3 'vert
Else
Range("O1") = "=N1/U1": Range("Q1") = "=P1/U1": Range("S1") = "Sur U"
ActiveSheet.DrawingObjects("BoutCoul").ShapeRange.Fill.ForeColor.SchemeColor
= 9
End If
ActiveSheet.DrawingObjects("BoutCoul").Caption = "FILTRE COULEUR"
Do
If ActiveCell.Interior.ColorIndex = couleur Then
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Row = 2 Then
Application.ScreenUpdating = True
[a65536].End(xlUp).Select
position.Select
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Exit Sub
End If
Else
ActiveCell.EntireRow.Hidden = True
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Row = 2 Then
Application.ScreenUpdating = True
position.Select
Exit Do
End If
End If
Loop
Application.ScreenUpdating = True
ActiveWindow.LargeScroll Down:=-5
Application.EnableEvents = True
Range("O1").FormulaLocal = "=N1/I1"
Range("Q1").FormulaLocal = "=P1/G1"
position.Select
'Range("C2").FormulaR1C1 = "ÊlcSpe(R3C:R[65000]C)"
Application.Calculation = xlCalculationAutomatic
End Sub

"suze32"
Bonjour à tous,

J'ai déjà posé un post ce matin, mais je me suit mal expliqué don je
réitère ma demande.

J'ai une base de donnée ou j'ai coloré des lignes entières par type,
et j'aimerai avoir une macro ou une fonction me permettant de faire un
tri de mes cellules par couleurs.

Je vous remercie de vos réponses, bonne aprèm



JB
Le #19891571
Bonjour,

http://boisgontierjacques.free.fr/pages_site/fichiers/Tri/TriCouleur3.xls

JB


On 6 août, 14:27, suze32
Bonjour à tous,

J'ai déjà posé un post ce matin, mais je me suit mal expliqué don je
réitère ma demande.

J'ai une base de donnée ou j'ai coloré des lignes entières par type ,
et j'aimerai avoir une macro ou une fonction me permettant de faire un
tri de mes cellules par couleurs.

Je vous remercie de vos réponses, bonne aprèm


Publicité
Poster une réponse
Anonyme