Tri excel/vba

sharkantipav · 1 Mai 2017

Bonjour, j'ai une question de Tri atypique,je n'arrive pas a la resoudre a part la faire manuellement.
Je souhaiterai le faire en VBA

J'ai attache un fichier exemple:
En colonne A j'ai des noms puis en colonnes B, C, D j'ai des nombres

1ere etape (facile): Consiste a trier la colonne B (nombres du plus petit au plus grand) pour separer en 2 blocs:
Les nombres > 0 Bloc du haut
Les 0 - Bloc du bas

2e etape (difficile): Trier le tableau ABCD par colonne A alphabetique pour Chaque Bloc c'est la partie difficile que je n'arrive pas a faire

Merci bcp

Dranreb · 1 Mai 2017

Bonjour.

VB:

Sub Macro1()
Dim Plage As Range
Set Plage = ActiveSheet.[A3:F3].Resize(ActiveSheet.[A1000000].End(xlUp).Row - 2)
Plage.Columns("F").FormulaR1C1 = "=SIGN(RC2)"
    Range("A3:F32").Select
With ActiveSheet.Sort
   .SortFields.Clear
   .SortFields.Add Key:=Plage.Columns("F"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
   .SortFields.Add Key:=Plage.Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   .SetRange Plage
   .Header = xlNo
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
   End With
Plage.Columns("F").ClearContents
End Sub

mapomme · 1 Mai 2017

Bonjour sharkantipav, Dranreb ,

Un autre essai. Le code se trouve dans le module de code de Sheet1.

VB:

Sub Trier()
Dim derlig&, plage As Range, nbr0&
  Application.ScreenUpdating = False
  derlig = Cells(Rows.Count, "a").End(xlUp).Row
  If derlig <= 3 Then Exit Sub Else Set plage = Range("a3:e" & derlig)
  plage.Sort key1:=plage(1, 2), order1:=xlDescending, Header:=xlNo
  nbr0 = Application.WorksheetFunction.CountIf(plage.Columns(2), 0)
  If plage.Rows.Count - nbr0 > 0 Then plage.Resize(plage.Rows.Count - nbr0).Sort key1:=plage(1, 1), order1:=xlAscending, Header:=xlNo
  If nbr0 > 0 Then plage.Offset(plage.Rows.Count - nbr0).Resize(nbr0).Sort key1:=plage(1, 1), order1:=xlAscending, Header:=xlNo
End Sub

Tri excel/vba

sharkantipav

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires