Double tri par ordre décroissant à l'intérieur d'un tableau / VBA

[lapluchouet]

Bonjour,

Comme je l'expliquais, je suis naze en VBA et je souhaiterais solliciter à nouveau vos méninges pour trouver une solution...
Il faudrait trier par ordre décroissant les lignes d'un tableau, présentant 3 colonnes et deux types d'infos : des "sous-totaux" (ST - ) et le détail de ces sous-totaux.
La mention "ST - " est systématique dans le libellé du sous-total et ne peut pas se retrouver dans les libellés du détail.

Libellé Effectif % col.

ST - Marque C 309 57,3
Orangé 15 2,8
Rose 294 54,5
ST - Marque X 403 74,8
Trop colorée 4 0,7
Repérable 400 74,2

Il faudrait donc trier par ordre décroissant le % des sous-totaux (ST -), puis à l'intérieur de chaque sous-total, le % du détail.
En sachant que le nombre de lignes à l'intérieur d'un sous-total est totalement variable... :


Libellé Effectif % col.

ST - Marque X 403 74,8
Repérable 400 74,2
Trop colorée 4 0,7
ST - Marque C 309 57,3
Rose 294 54,5
Orangé 15 2,8

Je joins un fichier présentant un tableau BRUT et le tableau que je souhaiterai obtenir.

Il faudrait en fait que la macro se réalise uniquement sur la sélection du tableau car la page Excel comportera d'autres tableaux et je souhaiterais pouvoir garder la main sur son exécution.

Et autre question : est-ce possible de réaliser ceci sur un tableau où la première colonne présente des cellules fusionnées... sans "défusionner" les cellules ?

Merci d'avance à tous 🙂

Dites-moi si je dois préciser certains éléments

 

[Dranreb]

Re : Double tri par ordre décroissant à l'intérieur d'un tableau / VBA

Bonsoir.

Cette macro fait-elle l'affaire ?

Sub Macro1()
Dim Plage As Range
Set Plage = Intersect(ActiveSheet.[B:F], Selection.EntireRow)
Plage.Columns(4).FormulaR1C1 = "=IF(LEFT(RC2,5)=""ST - "",RC4,R[-1]C)"
Plage.Columns(5).FormulaR1C1 = "=IF(LEFT(RC2,5)=""ST - "",ROW(),R[-1]C)"
With ActiveSheet.Sort
   .SortFields.Clear
   .SortFields.Add Key:=Plage.Columns(4), SortOn:=xlSortOnValues, _
      Order:=xlDescending, DataOption:=xlSortNormal
   .SortFields.Add Key:=Plage.Columns(5), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
   .SortFields.Add Key:=Plage.Columns(3), SortOn:=xlSortOnValues, _
      Order:=xlDescending, DataOption:=xlSortNormal
   .SetRange Plage
   .Header = xlNo
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
   End With
Plage.Columns(4).Resize(, 2).ClearContents
End Sub

 

[job75]

Re : Double tri par ordre décroissant à l'intérieur d'un tableau / VBA

Bonsoir lapluchouet,

Enregistrez le fichier en .xlsm, allez dans VBA (Alt+F11) et copiez cette macro dans un module standard :

Sub TriSousTotaux()
Dim P As Range, t, i&, x
Application.ScreenUpdating = False
Set P = [A1].CurrentRegion
Set P = P.Offset(, 1).Resize(P.Rows.Count - 1, 4)
t = P 'matrice,plus rapide
For i = 2 To UBound(t)
  If Left(t(i, 1), 2) = "ST" Then x = t(i, 3)
  t(i, 4) = x
Next
P.Columns(4) = Application.Index(t, , 4) 'colonne auxiliaire
P.Sort P.Columns(4), xlDescending, P.Columns(3), , xlDescending, Header:=xlYes
P.Columns(4).ClearContents
End Sub

Exécutez-la par Alt+F8, par un raccourci clavier, ou en cliquant sur un bouton.

Remarques :

- pas besoin de "sélectionner" le tableau puisqu'il est défini par la cellule A1 (CurrentRegion)

- la colonne A est exclue de la zone triée.

Edit : salut Bernard.

Bonne nuit.

 

[job75]

Re : Double tri par ordre décroissant à l'intérieur d'un tableau / VBA

Re,

Si vous avez plusieurs tableaux à trier de la même manière vous pouvez paramétrer la macro :

Sub TriTableau1()
TriSousTotaux [A1]
End Sub

Sub TriTableau2()
TriSousTotaux [F1]
End Sub

Sub TriTableau3()
TriSousTotaux [K1]
End Sub

Sub TriSousTotaux(cel As Range)
Dim P As Range, t, i&, x
Application.ScreenUpdating = False
Set P = cel.CurrentRegion
Set P = P.Offset(, 1).Resize(P.Rows.Count - 1, 4)
t = P 'matrice,plus rapide
For i = 2 To UBound(t)
  If Left(t(i, 1), 2) = "ST" Then x = t(i, 3)
  t(i, 4) = x
Next
P.Columns(4) = Application.Index(t, , 4)
P.Sort P.Columns(4), xlDescending, P.Columns(3), , xlDescending, Header:=xlYes
P.Columns(4).ClearContents
End Sub

Vous affecterez des raccourcis clavier différents à chacune des macros TriTableau1 TriTableau2 TriTableau3 etc...

A+

 

[lapluchouet]

Re : Double tri par ordre décroissant à l'intérieur d'un tableau / VBA

Merci à tous !!! vous êtes trop formidables <3 je ne sais pas si vous vous rendez compte que je vous considère comme des Dieux !! Merciiiiiiiiiiiiii