Microsoft 365 VBA - Tri par couleur de cellule

A

AD95

XLDnaute Junior
Bonjour à tous,

J'ai besoin d'un code VBA qui tri les cellules par couleur à partir de la colonne L5 jusqu'à la dernière colonne

Exemple : à partir de la colonne L5
1709226319455.png



Exemple de résultat attendu :


1709226360734.png



Merci d'avance pour votre aide !!!!!!!!!
 

Pièces jointes

  • Trier par couleur.xlsm
    18 KB · Affichages: 10
Solution
A
Cousinhub à dit:
Re-,
Allez, vite fait
VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long, DerLig As Long
With Worksheets("Feuil1")
    DerCol = .Cells(5, Columns.Count).End(xlToLeft).Column
    DerLig = .Cells.SpecialCells(xlCellTypeLastCell).Row
    Set Plg = .Range("L1").Resize(DerLig, DerCol - 11)
    .Sort.SortFields.Clear
    .Sort.SortFields.Add(Plg.Rows(5), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = .Range("L5").Interior.Color
    .Sort.SetRange Plg
    .Sort.Header = xlYes
    .Sort.Orientation = xlLeftToRight
    .Sort.Apply
End With
End Sub
Cliquez pour agrandir...
C'est parfaitement ça. Merci t'es un monstre 💪

J'ai bien le résultat attendu exemple de test

1709548602323.png


Merci beaucoup et bonne journée à toi...
Trier par date Trier par votes
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Bonjour,
Avec ce code (obtenu pratiquement avec l'enregistreur de macros)
J'ai supposé la dernière colonne en AA, donc plage de L à AA

VB: 
Sub Tri_H()
Dim Plg As Range
Set Plg = Range("A5").CurrentRegion.Offset(, 11).Resize(, 16)
With ActiveWorkbook.Worksheets("Feuil1").Sort
    .SortFields.Clear
    .SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
    .SetRange Plg
    .Header = xlYes
    .Orientation = xlLeftToRight
    .Apply
End With
End Sub
Bonne fin d'apm
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Bonjour CousinHub,

Un grand merci pour ton retour. Ca fonctionne nikel mais le problème c'est que je sais jamais quelle sera la couleur, la dernière colonne et la dernière ligne ça varie en fonction des données 🤪
Cousinhub à dit:
Bonjour,
Avec ce code (obtenu pratiquement avec l'enregistreur de macros)
J'ai supposé la dernière colonne en AA, donc plage de L à AA

VB: 
Sub Tri_H()
Dim Plg As Range
Set Plg = Range("A5").CurrentRegion.Offset(, 11).Resize(, 16)
With ActiveWorkbook.Worksheets("Feuil1").Sort
    .SortFields.Clear
    .SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
    .SetRange Plg
    .Header = xlYes
    .Orientation = xlLeftToRight
    .Apply
End With
End Sub
Bonne fin d'apm
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Bonjour,
Pour la dernière colonne, calcul rajouté - Toujours sur la base de la première colonne à trier -> colonne "L" (soit 11ème colonne)
Pour la couleur de tri, voir avec une voyante... :)
Ou donner un tout petit peu plus de précisions (méthode de choix)

VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long
DerCol = Worksheets("Feuil1").Cells(5, Columns.Count).End(xlToLeft).Column
Set Plg = Range("A5").CurrentRegion.Offset(, 11).Resize(, DerCol - 11)
With ActiveWorkbook.Worksheets("Feuil1").Sort
    .SortFields.Clear
    .SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
    .SetRange Plg
    .Header = xlYes
    .Orientation = xlLeftToRight
    .Apply
End With
End Sub
Bon dimanche
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Cousinhub à dit:
Bonjour,
Pour la dernière colonne, calcul rajouté - Toujours sur la base de la première colonne à trier -> colonne "L" (soit 11ème colonne)
Pour la couleur de tri, voir avec une voyante... :)
Ou donner un tout petit peu plus de précisions (méthode de choix)

VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long
DerCol = Worksheets("Feuil1").Cells(5, Columns.Count).End(xlToLeft).Column
Set Plg = Range("A5").CurrentRegion.Offset(, 11).Resize(, DerCol - 11)
With ActiveWorkbook.Worksheets("Feuil1").Sort
    .SortFields.Clear
    .SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
    .SetRange Plg
    .Header = xlYes
    .Orientation = xlLeftToRight
    .Apply
End With
End Sub
Bon dimanche
Cliquez pour agrandir...
Bonjour CousinHub,

Merci pour ton retour, pour les couleurs voici la commande que j'utilise dans le VBA sur mon fichier original

Palette de couleur
1709542099376.png




' fond Vert palette couleur 35 : & police en gras: & police en noir
.Cells(5, x).Interior.ColorIndex = 35: .Cells(5, x).Font.Bold = True: .Cells(5, x).Font.ColorIndex = xlAutomatic

'Fond Violet palette couleur 24
Else
.Cells(5, x).Interior.ColorIndex = 24: .Cells(5, x).Font.ColorIndex = xlAutomatic: _
.Cells(5, x).Font.Italic = False: .Cells(5, x).Font.Underline = xlUnderlineStyleNone


Exemple de couleur :
1709542311919.png



Merci d'avance, de ton aide 😅
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Bonjour,
La couleur de tri est fixée ici :

VB: 
.SortOnValue.Color = RGB(255, 255, 0)

Qu'on pourrait remplacer par ceci, en prenant comme couleur de tri la couleur de la cellule L5

Code: 
.SortOnValue.Color = Range("L5").Interior.Color

Si ce n'est toujours pas ça, je ne vois pas...
Bonne journée
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Cousinhub à dit:
Bonjour,
La couleur de tri est fixée ici :

VB: 
.SortOnValue.Color = RGB(255, 255, 0)

Qu'on pourrait remplacer par ceci, en prenant comme couleur de tri la couleur de la cellule L5

Code: 
.SortOnValue.Color = Range("L5").Interior.Color

Si ce n'est toujours pas ça, je ne vois pas...
Bonne journée
Cliquez pour agrandir...

Bonjour CousinHub,

J'ai un message d'erreur o_O

1709544143684.png
 

Pièces jointes

  • 1709544027863.png
    1709544027863.png
    37.2 KB · Affichages: 4
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
grrrrrr trop bête,

J'ai pas vue qu'il manquait le signe = 🤦‍♂️

C'est bon ça fonctionne merci beaucoup CousinHub pour ton aide 💪 !!!!!!!!

Voici le code Finale pour ceux que ça intéresse.


VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long
DerCol = Worksheets("Feuil1").Cells(5, Columns.Count).End(xlToLeft).Column
Set Plg = Range("A5").CurrentRegion.Offset(, 11).Resize(, DerCol - 11)
With ActiveWorkbook.Worksheets("Feuil1").Sort
    .SortFields.Clear
    .SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = Range("L5").Interior.Color
    .SetRange Plg
    .Header = xlYes
    .Orientation = xlLeftToRight
    .Apply
End With
End Sub

Bonne journée à toi :D
 

Pièces jointes

  • 1709544994980.png
    1709544994980.png
    129.3 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Re-,
Comment tu déroules le code?
En mode pas-à-pas, ou en auto?
Si en mode pas-à-pas, il faut bien aller jusqu'à ".Apply"
Sinon, est-ce que l'onglet se nomme bien "Feuil1"?
Et est-ce que cet onglet est bien activé?
Essaie en remplaçant ainsi :
VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long
With Worksheets("Feuil1")
    DerCol = .Cells(5, Columns.Count).End(xlToLeft).Column
    Set Plg = .Range("A5").CurrentRegion.Offset(, 11).Resize(, DerCol - 11)
    .Sort.SortFields.Clear
    .Sort.SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = .Range("L5").Interior.Color
    .Sort.SetRange Plg
    .Sort.Header = xlYes
    .Sort.Orientation = xlLeftToRight
    .Sort.Apply
End With
End Sub
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Cousinhub à dit:
Re-,
Comment tu déroules le code?
En mode pas-à-pas, ou en auto?
Si en mode pas-à-pas, il faut bien aller jusqu'à ".Apply"
Sinon, est-ce que l'onglet se nomme bien "Feuil1"?
Et est-ce que cet onglet est bien activé?
Essaie en remplaçant ainsi :
VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long
With Worksheets("Feuil1")
    DerCol = .Cells(5, Columns.Count).End(xlToLeft).Column
    Set Plg = .Range("A5").CurrentRegion.Offset(, 11).Resize(, DerCol - 11)
    .Sort.SortFields.Clear
    .Sort.SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = .Range("L5").Interior.Color
    .Sort.SetRange Plg
    .Sort.Header = xlYes
    .Sort.Orientation = xlLeftToRight
    .Sort.Apply
End With
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
dsl mais je viens de découvrir le problème (mon erreur)

Le code fonctionne dès lors qu'il n'y a pas de données dans la ligne 1, 2, 3 et 4

1709546328853.png


sauf que dans mon fichier originale je n'avais pas tenu compte qu'ils y en avaient du coup ça marche pas

1709546247234.png



Du coup, il faut prendre en compte que j'ai des données dans les 4 premières lignes 😅
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Re-,
On va y arriver...
VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long, DerLig As Long
With Worksheets("Feuil1")
    DerCol = .Cells(5, Columns.Count).End(xlToLeft).Column
    DerLig = .Cells.SpecialCells(xlCellTypeLastCell).Row
    Set Plg = .Range("L5").Resize(DerLig - 4, DerCol - 11)
    .Sort.SortFields.Clear
    .Sort.SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = .Range("L5").Interior.Color
    .Sort.SetRange Plg
    .Sort.Header = xlYes
    .Sort.Orientation = xlLeftToRight
    .Sort.Apply
End With
End Sub
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Cousinhub à dit:
Re-,
On va y arriver...
VB: 
Sub Tri_H()
Dim Plg As Range
Dim DerCol As Long, DerLig As Long
With Worksheets("Feuil1")
    DerCol = .Cells(5, Columns.Count).End(xlToLeft).Column
    DerLig = .Cells.SpecialCells(xlCellTypeLastCell).Row
[/QUOTE]

[QUOTE="Cousinhub, post: 20633242, member: 13730"]

    Set Plg = .Range("L5").Resize(DerLig - 4, DerCol - 11)
    .Sort.SortFields.Clear
    .Sort.SortFields.Add(Plg.Rows(1), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = .Range("L5").Interior.Color
    .Sort.SetRange Plg
    .Sort.Header = xlYes
    .Sort.Orientation = xlLeftToRight
    .Sort.Apply
End With
End Sub
Cliquez pour agrandir...
Merci à toi

Attend je crois je me suis mal exprimé.

Alors là le tri fonctionne mais à moitié 😅
En faite le tri doit se faire par couloir (situer à L5)
mais il doit prendre en compte aussi les lignes de 1 à 4 exemple le tri doit se faire de la colonne L1 à L(dernière ligne) ( en gros toute la colonne doit bouger)


Exemple avant Tri

1709547805489.png


Exemple après Tri (résultat attendus)

1709547907157.png


Désolé si je suis pas assez claire 😅
 
Vote positif 0 Vote négatif

Discussions similaires

Yann71
  • Question
Microsoft 365 Compter le nombre de cellule mise en couleur avec MFC
2
Réponses
19
Affichages
709
job75
job75
J
  • Résolu(e)
XL 2021 Coloriser une cellule avec un click d'une colonne
Réponses
10
Affichages
201
TooFatBoy
TooFatBoy
H
  • Résolu(e)
Microsoft 365 Tri et saut de ligne
2 3
Réponses
32
Affichages
851
AtTheOne
AtTheOne
Z
  • Résolu(e)
XL 2016 VBA EXPORT CSV
Réponses
7
Affichages
299
ZZ59264
Z
piga25
  • Résolu(e)
XL 2016 Mettre la même couleur de la dernière cellule colorée
Réponses
5
Affichages
329
TooFatBoy
TooFatBoy
AlCapone
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
155
AlCapone
AlCapone
jaclam
  • Question
Microsoft 365 Tableau
2
Réponses
24
Affichages
893
jaclam
jaclam
O
  • Résolu(e)
XL 2013 Formule ou Codage VBA qui met à jour un tableau en fonction de quantité
Réponses
5
Affichages
225
onyirimba
O
pompaero
  • Question
Microsoft 365 Repérer heure max et mini
Réponses
5
Affichages
227
pompaero
pompaero
A
  • Résolu(e)
Microsoft 365 VBA Etendre formule jusqu'à la dernière ligne dans VBA
Réponses
13
Affichages
494
AD95
A

Membres actuellement en ligne

8 membres et 96 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 095
Messages
2 116 166
Membres
112 675
dernier inscrit
Tazra_IMOU