Microsoft 365 VBA - Tri par couleur de cellule

AD95 · 29 Février 2024

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

Exemple de résultat attendu :

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

AD95 · 4 Mars 2024

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

C'est parfaitement ça. Merci t'es un monstre

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

Merci beaucoup et bonne journée à toi...

Cousinhub · 29 Février 2024

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

AD95 · 1 Mars 2024

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

Cousinhub · 3 Mars 2024

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

AD95 · 4 Mars 2024

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

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

' 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 :

Merci d'avance, de ton aide

Cousinhub · 4 Mars 2024

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

AD95 · 4 Mars 2024

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

Bonjour CousinHub,

J'ai un message d'erreur

Cousinhub · 4 Mars 2024

Re-,
Euh, t'as rien oublié?
Manquerait pas un signe = ?

AD95 · 4 Mars 2024

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

Cousinhub · 4 Mars 2024

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

AD95 · 4 Mars 2024

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

AD95 · 4 Mars 2024

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

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

Du coup, il faut prendre en compte que j'ai des données dans les 4 premières lignes

Cousinhub · 4 Mars 2024

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

AD95 · 4 Mars 2024

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

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

Exemple après Tri (résultat attendus)

Désolé si je suis pas assez claire

Cousinhub · 4 Mars 2024

Re-,
Je ne répondrai que lorsque que tu auras donné TOUS les éléments...
Parce qu'après, y'aura quoi?

Microsoft 365 VBA - Tri par couleur de cellule

AD95

XLDnaute Junior

Pièces jointes

AD95

Cousinhub

XLDnaute Barbatruc

AD95

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

AD95

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

AD95

XLDnaute Junior

Pièces jointes

Cousinhub

XLDnaute Barbatruc

AD95

XLDnaute Junior

Pièces jointes

Cousinhub

XLDnaute Barbatruc

AD95

XLDnaute Junior

AD95

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

AD95

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

Discussions similaires