XL 2021 tri par lignes

[rastafouette]

Bonjour à tous,

Voilà, j'ai une macro qui remplit un tableau avec les noms sur la ligne 5 et en dessous de chaque nom, ce que chacun a selectionné, ou pas (=> certaines colonnes ont un nom mais sont vides)
=> Je voudrais trier comme ça : que les colonnes non vides se regroupent sur la gauche, en ordre alphabetique, et les autres ensuite.
Le tout dans une macro

Pour le detail supplémentaire, dans le deroulement de ma macro, lorsqu'un nom s'ajoute, je voudrais l'ajouter en fin de ligne 5, sur la dernière cellule vide, avec ses choix en dessous, Puis ensuite, trier comme ci-dessus. Et ça je tourne autour sans y arriver : simplement trouver la dernière cellule vide de la ligne.

Merci d'avance de votre aide !

 

[Cousinhub]

Bonjour,
Un essai

Sub Tri()
Dim Plg As Range
Dim DerCol As Long, DerLig As Long
Application.ScreenUpdating = False
DerCol = Cells(5, Columns.Count).End(xlToLeft).Column - 6
DerLig = Cells(Rows.Count, "B").End(xlUp).Row - 3
Set Plg = Range("G4").Resize(DerLig, DerCol)
Plg.Resize(1).FormulaR1C1 = "=COUNTA(R[2]C:R[" & DerLig - 1 & "]C)>0"
With ActiveWorkbook.Worksheets("aaaa").Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=Plg.Resize(1), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    .SortFields.Add2 Key:=Plg.Offset(1).Resize(1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Plg
    .Header = xlYes
    .Orientation = xlLeftToRight
    .Apply
End With
Plg.Resize(1).ClearContents
End Sub

Bon dimanche

 

[sylvanu]

Bonjour rastafouette, Cousinhub,
Franchement à labour, un truc qui ressemble à la macro de Cousinhub.

 

[rastafouette]

Merci beaucoup !!

Il me reste à voir comment les appliquer à mon tableau de base.

 

[sylvanu]

Re,
Pour la macro du post #3, c'est une macro classique à mettre dans un module standard. Elle s'adapte au tableau quelle que soient le nombre de lignes et colonnes.
Juste une question : en colonne F pourqioi faire :

=SOMME(DECALER($E6;;2;):DECALER($E6;;NBVAL($G$5:$AZ$5)+1;))
au lieu de
=SOMME(G6:AZ6)

car comme vous utilisez déjà AZ5 cela signifie qu'il n'y a rien à droite du tableau.

 

[job75]

Bonjour à tous,

Comme Cousinhub mais en un peu plus simple :

Sub TriHorizontal()
Dim dercel As Range
Set dercel = Cells.SpecialCells(xlCellTypeLastCell)
With Range([G4], dercel)
    .Rows(1) = "=SIGN(SUM(R[1]C:R" & dercel.Row & "C ))"
    .Sort .Rows(1), xlDescending, .Rows(2), , xlAscending, Header:=xlNo, Orientation:=2
    .Rows(1).ClearContents 'RAZ
End With
End Sub

J'ai nettoyé le UsedRange pour que la dernière cellule soit W18, ce n'est pas indispensable mais c'est plus propre.

A+

 

[rastafouette]

Pour la question, j'ai simplifié mon tableau d'exemple avec $AZ$5. Cette formule était utile l'an dernier mais effectivememnt, avec les changememtns que je fais en ce moment, je pourrai changer.
J'ai encore des choses sous le tableau donc je dois adapter vos solutions.
Je suis partie pour adapter la solution de Cousinhub car j'avoue que je ne pige pas trop la tienne sylvanu.

 

[job75]

J'ai encore des choses sous le tableau donc je dois adapter vos solutions.

Il faudrait nous montrer ça car ma solution trie en même temps ce qu'il y a sous le tableau.

 

[job75]

Bon avec cette solution vous pouvez mettre tout ce que vous voulez sous le tableau.

La macro réunit toutes les cellules de la feuille colorées en bleu :

Sub TriHorizontal()
Dim c As Range, P As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
    If c.Interior.Color = RGB(217, 225, 242) Then Set P = Union(IIf(P Is Nothing, c, P), c)
Next
Set P = Union(P.Rows(0), P)
P.Rows(1) = "=SIGN(SUM(R[1]C:R" & P.Row + P.Rows.Count - 1 & "C ))"
P.Sort P.Rows(1), xlDescending, P.Rows(2), , xlAscending, Header:=xlNo, Orientation:=2
P.Rows(1).ClearContents 'RAZ
End Sub

Edit : j'ai ajouté Application.ScreenUpdating = False

 

[job75]

L'analyse de la couleur des cellules m'inquiétait un peu.

J'ai recopié la plage G6:W18 sur 13 000 lignes => la macro s'exécute chez moi en 3,75 secondes, c'est acceptable.

 

[rastafouette]

Pour être plus précise
La hauteur du tableau sera limitée à la colonne B et aux codes, si la colonne B est remplie dans cette zone. Et la longueur à droite au nombre d'adhérents, le jour où on arrive à 50 je sabre le champagne.
La ligne en dessous, ce sont des sommeprod avec des mfc qui verifient les prix.

J'améliore mon fichier d'année en année (une grosse userform, plusieurs onglets...) mais j'ai sans doute pas mal de mini usine à gaz dans tout ça, j'essaie de simplifier en furetant ici, même si ce n'est pas évident de trouver dans le flot de messages.
Mon but est surtout de faire un fichier qui se modifie tout seul selon les options des adhérents, pour que ça puisse conitnuer à fonctionner tout seul, même quand je ne serai pas là, donc sans aller changer les numéros de colonne et autre dans le code.

En exemple d'usine à gaz, j'ai une partie de mon usf qui est très longue en traitement alors qu'objectivement elle ne fait pas grand chose. Auriez vous qques posts qui traiteraient de ça par hasard ?

 

[rastafouette]

Bonjour à tous,

Je viens vers vous pour un complément sur mon fichier.
Voilà. En plus de votre aide pour le tri, (encore merci !!) j'ai rajouté un petit truc dans mon code pour que les nouvelles personnes se rajoutent automatiquement avec leurs données.
Ce que je cherche à faire, que je voudrais automatique (via une formule(?) mais je ne trouve pas), c'est le fait de passer du tableau bleu au tableau vert en dessous ( que je mets dans un autre onglet, dans les faits), c'est à dire, qque soit ce qu'on modifie/rajoute dans le bleu, le vert se mets à jour (ordre alphabetique des personnes).

Est ce que, à tout hasard, vous auriez une petite idée ?

 

[job75]

Bonsoir,

Ce que je cherche à faire, que je voudrais automatique (via une formule(?) mais je ne trouve pas), c'est le fait de passer du tableau bleu au tableau vert en dessous ( que je mets dans un autre onglet, dans les faits), c'est à dire, qque soit ce qu'on modifie/rajoute dans le bleu, le vert se mets à jour (ordre alphabetique des personnes).

Cette macro fait cela après le tri :

Sub Trier()
Dim dercol%, P As Range, derlig&, lig&, j%, i&
Application.ScreenUpdating = False
With Sheets("aaaa")
    dercol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    Set P = .Range("F4", .[F:F].SpecialCells(xlCellTypeFormulas)).Offset(, 1).Resize(, dercol - 6)
End With
derlig = P.Row + P.Rows.Count - 1
P.Rows(1) = "=SIGN(SUM(R[1]C:R" & derlig & "C ))"
P.Sort P.Rows(1), xlDescending, P.Rows(2), , xlAscending, Header:=xlNo, Orientation:=2 'tri horizontal
P.Rows(1).ClearContents 'RAZ
'---tableau de la feuille Synthèse---
With Sheets("Synthèse")
    lig = 2
    .Cells(lig, 1).Resize(.Rows.Count - lig + 1, 3).Delete xlUp 'RAZ
    For j = 1 To dercol - 6
        If Application.Count(P.Columns(j)) = 0 Then Exit For
        .Cells(lig, 1) = P(2, j)
        For i = 3 To derlig - 3
            If IsNumeric(CStr(P(i, j))) Then
                .Cells(lig, 2) = P(i, -4)
                .Cells(lig, 3) = P(i, -5)
                lig = lig + 1
            End If
    Next i, j
    .[A1].CurrentRegion.Interior.Color = RGB(226, 239, 218) 'vert
    .[A1:C1].Interior.Color = vbCyan
    .Columns("A:C").AutoFit 'ajustement largeurs
End With
End Sub

A+

 

[rastafouette]

Bonsoir,

Cette macro fait cela après le tri :

Génial !! Parfait !! 😁😁😁

Me reste à le comprendre pour l'adapter à mon fichier.

MERCI BEAUCOUP A TOUS !!! 🙏🙏🙏

 

[rastafouette]

Question qui me turlupine quand même.

Est ce que ça serait possible de faire ça par des formules directement sur l'onglet ?
Où le fait que, à chaque rajout de 1 dans les colonnes, ça rend la gestion par formule impossible ?

Question à 10 cts supplémentaire : comment je supprime cette vieille signature automatique sous mes posts ? je troue rien dans le profil pour ça ?