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: 9
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
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
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
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: 3
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: 3
Dernière édition:
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
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
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

A
  • Résolu(e)
Microsoft 365 VBA Etendre formule jusqu'à la dernière ligne dans VBA
Réponses
13
Affichages
203
AD95
A
A
  • Résolu(e)
Microsoft 365 Nommer des feuilles en fonction des données d'une colonne
Réponses
9
Affichages
262
AD95
A
A
  • Résolu(e)
Microsoft 365 Formule Indirect à intégrer dans VBA
Réponses
9
Affichages
209
AD95
A
K
  • Question
Autres 'Resolu' 'Nettoyer' des lignes par une macro
Réponses
7
Affichages
235
klorane
K
M
  • Question
Autres Nombre cellules vides par mois
Réponses
3
Affichages
278
sylvanu
sylvanu
M
  • Résolu(e)
Microsoft 365 Code de tri
2
Réponses
22
Affichages
300
Dudu2
Dudu2
J
  • Question
XL 2019 Filtrage des données dans un TCD
Réponses
10
Affichages
222
Cousinhub
Cousinhub
F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
175
ftpo69
F
N
  • Question
XL 2016 additionner des valeurs suite à une recherche de valeur cible
Réponses
3
Affichages
180
Annach
A
C
  • Résolu(e)
Microsoft 365 Trouver résultat en fonction de la dernière ligne d'une colonne
Réponses
7
Affichages
133
Chounoé
C

Membres actuellement en ligne

5 membres et 48 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
312 206
Messages
2 086 220
Membres
103 158
dernier inscrit
laufin