[VBA] Tri de ligne depuis cellule active avec plusieurs critères

Bonjour,

Je souhaiterais faire un tri d'entreprises sur les cellules sélectionnées et selon des critères bien définis.

Le tri devra s'appliquer à la ligne entière.

• Cellules fonds verts et ordre alphabétique en premier.

• Cellules avec textes noirs et ordre alphabétique en deuxième.

• Cellules avec textes rouges et ordre alphabétique en troisième.

Voici une ébauche d'un code qui tri les cellules actives en ordre alphabétique.

Sub tri()
'Macro tri

Dim col As Byte
Dim plage As Range
Set plage = ActiveCell.CurrentRegion
col = ActiveCell.Column
With ThisWorkbook.ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Cells(, col), SortOn:=xlSortOnValues, Order:=xlAscending
    .SetRange plage
    .Header = xlNo
    On Error Resume Next
    .Apply
End With
End Sub

Voici un code obtenu avec l'outil "enregistrer une macro".

Sub Macro2()
'
' Macro2 Macro
'
'
    Range("B3:C9").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add(Range("B4:B9"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(112, _
        173, 71)
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add(Range("B4:B9"), _
        xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 0, 0 _
        )
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add2 Key:=Range("B4:B9") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("B3:C9")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Je vous joins aussi un fichier Excel avec l'exemple.

Auriez-vous une idée et solution pour unir les deux codes ?

Salut GU11,

il faudrait surtout connaître le critère qui classe les entreprises sinon, tu es bon pour le faire à la main à chaque fois !

Ne me dis pas que ce sont ces couleurs !?

A+

curulis57 a écrit :

Salut GU11,

il faudrait surtout connaître le critère qui classe les entreprises sinon, tu es bon pour le faire à la main à chaque fois !

Ne me dis pas que ce sont ces couleurs !?

A+

Oui cela pourrait être laborieux haha, les critères sont indiqués plus loin dans le tableau (non joint au fichier Excel). Le style est appliqué avec une mise en forme conditionnelle à l'aide de ces critères.

Le must serait que tout soit automatique avec un classement dynamique (peut être plus simple d’ailleurs), cependant une macro VBA et un raccourci clavier me va pour l'instant, le tableau ne varie pas beaucoup.

C'est malin, tiens, ça... Tu as des critères et tu les caches !!

Envoie, stp, si tu veux de l'automatique et tant qu'à faire, explique-nous tes critères que l'on gagne du temps !

A+

curulis57 a écrit :

C'est malin, tiens, ça... Tu as des critères et tu les caches !!

Envoie, stp, si tu veux de l'automatique et tant qu'à faire, explique-nous tes critères que l'on gagne du temps !

A+

J'ai mis à jour mon fichier Excel, cependant ma demande n'est pas spécifique à ce fichier Excel.

Mes souhaits seraient d'avoir un module à importer et facilement modifiable.

J'aimerais vraiment comprend comment mettre en place ce script.

Salut Guu11,

avant de développer quoi que ce soit, j'aimerais avoir un fichier dont la structure soit identique à l'original : pas envie de recommencer 20 fois !

Cela dit, tu peux, sans MFC, trier manuellement UNE SECTION (01 - Gros-oeuvre, par ex.) comme ceci :

• d'abord, dans la colonne "Refus", remplacer les cellules vides par un tiret ;
• sélectionner la section de tableau avec ses en-têtes ;
• menu 'Accueil' - Trier - Tri personnalisé ;
• bien cocher "Mes données ont des en-têtes" ;
• 1er niveau : trier par la colonne "Date réception" -> Valeurs de cellule - Du plus ancien au plus récent ;
• 2e niveau : trier par la colonne "Refus" -> Valeurs de cellule -> De A à Z.

La suite VBA sur présentation d'un fichier réaliste !

A+