Accueil

TriSimple
TriMultiCrit
TriPerso
SousTot
Fonction Sous.Total()
Tri VBA
Tri 2 Critères
Tri lignes & colonnes
Tri Zones Vides
Tri numérique de valeurs alphanumériques
Tri dynamique
Tri par groupe
Tri de fiches
Tri colonnes
Tri Gras
Tri sur la couleur de fond
Tri cadres
Tri avec images
Tri par clic sur le titre
Tri mots avec apostrophes
Tri multi-feuilles
Tri des onglets
Tri quick-sort
Tri matriciel
Fonction liste triée
Liste triée Multi-Zones
Tri de multiples blocs
Fonction Tri & Filtre

Tri simple

• Cliquer dans la colonne de tri (B2 pour trier par service)
• Icône A-Z

Tri multi-critères

• Cliquer dans la base (A1 par exemple)
• Données/Trier

Tri personnalisé

On veut trier par service dans l'ordre DG,Etudes,Marketing,Ventes,Fabric:

• Créer une liste personalisée (DG,Etudes,Marketing,Ventes,Fabric) avec la commande Outils/Options/Liste perso
• Cliquer dans la base
• Données/Trier
• Choisir Service
• Options
• Choisir la liste personnalisée

Création liste personnalisée

Options de tri

Sous totaux

On veut obtenir la moyenne des salaires par service.

• Trier par service
• Données/sous-total

Fonction Sous.Total(NoFonction;champ1;Champ2, ..)

Donne un total dans une liste filtrée.

Sur cet exemple, nous calculons des sous-totaux par poste et un total général.

Tri en VBA

champ.Sort Key1:=cellule, Order1:=xlAscending/XlDescending,
    Key2:=cellule, Order2:=xlAscending/XlDescending,
    Key3:=cellule, Order3:=xlAscending/XlDescending,
    Header:=xlGuess

Tri 1 critère

Sub tri()
   Sheets("BD").[A1].Sort key1:=Sheets("BD").[A2], Order1:=xlAscending, Header:=xlGuess
End Sub

Tri 2 critères

Sub tri2()
   Sheets("BD2").[A1].Sort key1:=Sheets("BD2").[A2], Order1:=xlAscending, _
       key2:=Sheets("BD2").[B2], Order2:=xlAscending, Header:=xlGuess
End Sub

Tri lignes & colonnes d'un tableau 2D

Tri Lignes & Colonnes

Sub TriLigCol()
  Set Adr = Range("A1")
  Nlignes = Adr.CurrentRegion.Rows.Count - 1
  Ncols = Adr.CurrentRegion.Columns.Count - 1
  '--- tri lignes & colonnes
  Set Rng = Adr.Resize(Nlignes, Ncols)
  Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count).Sort key1:=Rng.Cells(2, 1), _
     Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortColumns
  Rng.Offset(, 1).Resize(Rng.Rows.Count, Rng.Columns.Count - 1).Sort key1:=Rng.Cells(1, 2), _
     Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortRows
End Sub

Tri vertical

Tri Vertical

Tri horizontal d'une ligne

Tri horizontal d'une ligne

Sub Tri()
  For i = 0 To 4
    Set Rng = Range("B6:F6").Offset(i)
    Rng.Sort key1:=Rng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, MatchCase:=False,       Orientation:=xlSortRows
  Next i
End Sub

Tri avec zones incomplétes

On veut trier par département.

TriVides
TriVides2

Sub Tri()
  Set début = Range("A1")
  ncol = début.CurrentRegion.Columns.Count
  début.Offset(0, ncol).EntireColumn.Insert Shift:=xlToRight
  Set rng1 = début.CurrentRegion.Resize(, 1)
  Set Rng2 = début.CurrentRegion.Offset(0, ncol).Resize(, 1)
  Rng2.Value = rng1.Value
  Rng2.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
  Rng2.Value = Rng2.Value
  début.Sort Key1:=Cells(1, ncol + 1), Order1:=xlAscending, _
      Header:=xlGuess
  Cells(1, ncol + 1).EntireColumn.Delete
End Sub

Tri

-Italic en second
-Gras en troisième
-Barré en 4e

TriGrasItalBarré

Sub TriCol()
  Columns("B:B").Insert Shift:=xlToRight
  For i = 2 To [a65000].End(xlUp).Row
    Cells(i, 2) = 1
    If Cells(i, 1).Font.Bold Then Cells(i, 2) = 3
    If Cells(i, 1).Font.Italic Then Cells(i, 2) = 2
    If Cells(i, 1).Font.Strikethrough Then Cells(i, 2) = 4
   Next
   [A2].CurrentRegion.Sort Key1:=[B2], Order1:=xlAscending, Header:=xlYes
   [B:B].Delete Shift:=xlToLeft
End Sub

Conserve le focus après tri

TriFocus

Sub TriNom()
  nom = Cells(ActiveCell.Row, 1)
  col = ActiveCell.Column
  [A2:C1000].Sort key1:=[A2]
  On Error Resume Next
  [a:a].Find(what:=nom).Offset(, col - 1).Select
End Sub

Tri dans l'ordre numérique de valeurs alphanumériques

Tri Numérique
Tri suivant Numérique
Tri Alpha après Numérique
Tri AlphaNumSansDoublons

Sub triColInter2()
  [b:b].Insert
  For Each c In Range([A2], [a65000].End(xlUp))
    c.Offset(0, 1) = Val(c)
  Next c
  Range("A2").CurrentRegion.Select
  Selection.Offset(1).Resize(Selection.Rows.Count - 1).Select
  Selection.Sort Key1:=[B2]
  [b:b].Delete
End Sub

Tri AlphaNum Plusieurs séquences

Choix de la colonne de tri dans une liste

TriMenu

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$G$2" And Target.Count = 1 Then
     col = Application.Match(Target, [A1:D1], 0) - 1
     Range("A2:D30").Sort Key1:=[A1].Offset(0, col)
   End If
End Sub

Tri dynamique

Le tri est effectué à chaque saisie d'un nom

Tri Dynamique

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target.Count = 1 Then
    m = Target
    [A2:C1000].Sort Key1:=[A2]
    [A:A].Find(What:=m, LookIn:=xlValues).Select
  End If
End Sub

Tri par groupe

TriGroupe

Sub TriCol()
  Columns("B:B").Insert Shift:=xlToRight
  i = 1
  Do While i <= [a65000].End(xlUp).Row
    temp = Cells(i, 1)
    Cells(i, 2) = temp
    i = i + 1
    Do While Not Left(Cells(i, 1), 1) = "[" And i <= [a65000].End(xlUp).Row
      Cells(i, 1).Offset(0, 1) = temp & Cells(i, 1)
      i = i + 1
    Loop
  Loop
  [A1].CurrentRegion.Sort Key1:=[B2], Order1:=xlAscending, Header:=xlNo
  [B:B].Delete Shift:=xlToLeft
End Sub

Tri les Blocs

Les blocs sont repérés par une couleur. Il n'y a pas de quadrillage.

Tri Blocs

Sub Tri()
  nbCol = [A1].CurrentRegion.Columns.Count
  couleurPremier = [A1].Interior.ColorIndex
  Columns("A:A").Offset(0, nbCol).Insert Shift:=xlToRight
  i = 1
  Do While i <= [a65000].End(xlUp).Row
    temp = Cells(i, 1)
    Cells(i, 1).Offset(0, nbCol) = temp
    i = i + 1
    Do While Cells(i, 1).Interior.ColorIndex <> couleurPremier And i <= [a65000].End(xlUp).Row
      Cells(i, 1).Offset(0, nbCol) = temp
      i = i + 1
    Loop
  Loop
  [A1].CurrentRegion.Sort Key1:=Range("A1").Offset(0, nbCol), Order1:=xlAscending, Header:=xlNo
  [A:A].Offset(0, nbCol).Delete Shift:=xlToLeft
End Sub

Tri suivant les titres en gras

TriCol

Sub TriCol()
  Columns("B:B").Insert Shift:=xlToRight
  i = 1
  Do While i <= [a65000].End(xlUp).Row
    temp = Cells(i, 1)
    Cells(i, 2) = temp
    i = i + 1
    Do While Not Cells(i, 1).Font.Bold And i <= [a65000].End(xlUp).Row
       Cells(i, 1).Offset(0, 1) = temp & Cells(i, 1)
       i = i + 1
    Loop
  Loop
  [A1].CurrentRegion.Sort Key1:=[B2], Order1:=xlAscending, Header:=xlNo
  [B:B].Delete Shift:=xlToLeft
End Sub

Tri de fiches

Tri Fiches
Tri Fiches2
Tri Fiches Colonne

Sub Tri(LigneDébut, HauteurBloc, numCol, ordre, DecalTri)
  nbcol = Cells(LigneDébut, 1).CurrentRegion.Columns.Count
  Columns("A:A").Offset(0, nbcol).Insert Shift:=xlToRight
  i = LigneDébut
  Do While i <= [a65000].End(xlUp).Row
    Cells(i, nbcol + 1).Resize(HauteurBloc, 1) = Cells(i + DecalTri, numCol)
    i = i + HauteurBloc
  Loop
  derLig = Cells(65000, nbcol + 1).End(xlUp).Row
  Range(Cells(LigneDébut, 1), Cells(derLig, nbcol + 1)).Sort _
     Key1:=Cells(LigneDébut + 1, 1).Offset(0, nbcol), Order1:=ordre, Header:=xlNo
  [A:A].Offset(0, nbcol).Delete Shift:=xlToLeft
End Sub

Sub triNom()
  Tri 7, 3, 1, xlAscending, 0
End Sub

Sub triDateNaissance()
  Tri 7, 3, 3, xlDescending, 0
End Sub

Sub triDateEntrée()
  Tri 7, 3, 2, xlAscending, 0
End Sub

Tri groupes tailles différentes

Tri groupes tailles différentes
Tri Blocs tailles différentes

Sub TriGroupes()
  Application.ScreenUpdating = False
  ligneDéb = 2
  NoBordure ' supprime les bordures
  NbCol = 3
  Columns("A:A").Offset(0, NbCol).Insert Shift:=xlToRight
  i = ligneDéb
  Do While i <= [A65000].End(xlUp).Row + 1
    temp = Cells(i, 1)
    temp2 = Cells(i, 1)
    Cells(i, 1).Offset(0, NbCol) = temp2
    i = i + 1
    Do While Cells(i, 1) = "" And i <= [C65000].End(xlUp).Row
      Cells(i, 1).Offset(0, NbCol) = temp2
      i = i + 1
    Loop
  Loop
  Range(Cells(ligneDéb, 1), Cells([C65000].End(xlUp).Row, NbCol + 1)).Sort Key1:=Cells(ligneDéb, 1).Offset(,     NbCol), Order1:=xlAscending, Header:=xlNo
  [A:A].Offset(0, NbCol).Delete Shift:=xlToLeft
  Bordures ligneDéb, NbCol
End Sub

Tri colonnes

On veut trier le tableau par lignes & colonnes.

Tri colonnes

Sub TriColTbl2D()
  Set Rng = Range("B1:F" & [B65000].End(xlUp).Row)
  Rng.Sort key1:=Rng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, MatchCase:=False,       Orientation:=xlSortRows
End Sub

Sub TriLigTbl2D()
  Set Rng = Range("A2:G" & [B65000].End(xlUp).Row - 1)
  Rng.Sort key1:=Rng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, MatchCase:=False,      Orientation:=xlSortColumns
End Sub

Tri sur la couleur de fond

Tri Couleur Fond
Tri Couleur Fond2

Tri cadres

Tri Cadres
Tri Cadres 2
Tri Hauteur ligne

Sub Tri2()
  Set debut = Range("A1") ' à adapter
  n = debut.CurrentRegion.Rows.Count
  nf = ActiveSheet.Name
  Sheets.Add
  ActiveSheet.Name = "temp"
  Sheets(nf).Select
  debut.CurrentRegion.Copy Sheets("temp").[A1]
  nbcol = debut.CurrentRegion.Columns.Count
  debut.Offset(0, nbcol).EntireColumn.Insert Shift:=xlToRight
  debut.Offset(1, nbcol) = 1
  debut.Offset(1, nbcol).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
    Step:=1, Stop:=n - 1, Trend:=False
  debut.Resize(n, nbcol + 1).Sort Key1:=debut.Offset(1, 0), Order1:=xlAscending, Header:=xlGuess
  For i = 1 To n - 1
    x = debut.Offset(i, nbcol) + 1
    Sheets("temp").Cells(x, 1).Resize(, nbcol).Copy debut.Offset(i, 0)
  Next i
  debut.Offset(0, nbcol).EntireColumn.Delete
  Application.DisplayAlerts = False
  Sheets("temp").Delete
End Sub

Tri avec images

TriImages

Il faut que les images aient la propriété Déplacer

Sub modifieMove()
  For Each c In ActiveSheet.Shapes
    If c.Type = 13 Then c.Placement = xlMoveAndSize
  Next c
End Sub

Sub Tri()
   [A1].CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False
End Sub

Tri sur double-clic sur le titre

TriTitre
TriTitre2

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Set titre = [A1:D1]
  If Not Intersect(titre, Target) Is Nothing And Target <> "" Then
    OrdreTri = IIf(Target.Interior.ColorIndex = 3, xlDescending, xlAscending)
    Target.CurrentRegion.Sort Key1:=Cells(1, Target.Column), Order1:=OrdreTri, Header:=xlGuess
    m = IIf(Target.Interior.ColorIndex = 3, 4, 3)
    titre.Interior.ColorIndex = 44
    Target.Interior.ColorIndex = m
  End If
  Cancel = True
End Sub

Tri sur le 3e caractère dans un ordre prédéfini (GPBO)

TriCode

Sub Macro1()
  Set debut = [A2]
  debut.Offset(, 1).EntireColumn.Insert
  Set plage = debut.Resize(debut.CurrentRegion.Rows.Count - 1)
  For Each c In plage
    c.Offset(, 1) = Left(c, 2) & InStr("GPBO", Mid(c, 3, 1)) & Mid(c, 4)
  Next c
  plage.Resize(, 2).Sort Key1:=debut.Offset(, 1), Order1:=xlAscending, Header:=xlGuess
  debut.Offset(, 1).EntireColumn.Delete
End Sub

Tri avec apostrophes

Les mots avec apostrophes sont regroupés.

TriApostrophes

Sub TriApostrophe()
  [b:b].Insert
  For Each c In Range([A2], [a65000].End(xlUp))
    c.Offset(0, 1) = Replace(c, "'", " ")
  Next c
  Range("A2").CurrentRegion.Select
  Selection.Sort Key1:=[B2], Header:=xlGuess
  [b:b].Delete
End Sub

Tri multi-feuilles

Feuil1 , Feuil2, Feuil3 contiennent chacune 50.000 lignes

-On fusionne Feuil1+Feuil2+Feuil3
-On tri l'ensemble
-L'ensemble est découpé sur Feuil4,Feuil5,Feuil6

TriMultiFeuilles

Tri des onglets

Tri Onglets.xls
Tri Onglet Ordre

Sub tri_ongletDirect()
  Application.ScreenUpdating = False
  For i = 1 To Sheets.Count
    For j = i To Sheets.Count
      If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
        Sheets(i).Move before:=Sheets(j)
        Sheets(j).Move before:=Sheets(i)
      End If
    Next j
  Next i
End Sub

Noms d' onglets numériques et alpha

Sub tri_ongletDirect2()
   Application.ScreenUpdating = False
   For i = 1 To Sheets.Count
     For j = i To Sheets.Count
       If IsNumeric(Sheets(j).Name) Then
         x = String(30 - Len(Sheets(j).Name), "0") & Sheets(j).Name
       Else
         x = UCase(Sheets(j).Name)
     End If
     If IsNumeric(Sheets(i).Name) Then
       y = String(30 - Len(Sheets(i).Name), "0") & Sheets(i).Name
     Else
       y = UCase(Sheets(i).Name)
     End If
    If x < y Then
      Sheets(i).Move before:=Sheets(j)
      Sheets(j).Move before:=Sheets(i)
    End If
   Next j
  Next i
End Sub

Tri dans une feuille temporaire

Sub trionglet2()
   Sheets.Add
   ActiveSheet.Name = "Tempo_jb"
   For i = 1 To Sheets.Count
      Cells(i, 1) = "'" & Sheets(i).Name
   Next i
   Range("A1:A256").Sort Key1:=Range("A1")
   For i = 1 To Sheets.Count
      nonglet = Cells(i, 1)
      Sheets(nonglet).Move before:=Sheets(i)
      Sheets("Tempo_jb").Activate
   Next i
   Application.DisplayAlerts = False
   Sheets("Tempo_jb").Delete
   Sheets(1).Activate
End Sub

Tri dans un tableau

Sub tri_onglet()
Application.ScreenUpdating = False
Dim a(256)
n = Sheets.Count
For i = 1 To n
a(i) = Sheets(i).Name
Next i
'---- tri
For i = 1 To n
For j = i To n
If a(j) < a(i) Then
temp = a(j)
a(j) = a(i)
a(i) = temp
End If
Next j
Next i
'---
For i = 1 To n
Sheets(a(i)).Move before:=Sheets(i)
Next i
Sheets(1).Select
End Sub

Tri Quick-Sort

Le principe est le suivant:

On répartit la suite de nombres à trier de telle sorte que tous les éléments inférieurs à un élément de référence (36 sur l'exemple) soient à gauche de celui-ci et que tous ceux qui lui sont supérieurs à sa droite.

[70 61 16 48 29 18 59 36 3 70 3 22 39 30 58 10] <- Avant
                                  ¦
             Elément médian de référence
                             ¦
[3 30 16 22 29 18] 36 [70 59 48 39 59 61 58 70] <- Après

               ¦                              ¦
Eléments<36                   Eléments>36

Tous les éléments de l'ensemble de droite sont supérieurs à ceux de l'ensemble de gauche. En procédant de la même façon sur les 2 sous-ensembles générés,on obtient 4 sous-ensembles ordonnés entre eux. Lorsque la taille des ensembles devient égale à 1,les nombres sont triés.

Choix de l'élément de référence:

Pour obtenir des sous-ensembles de tailles équilibrées,il faut que l'élément de référence ne soit ni trop petit,ni trop grand.

La méthode classique consiste à choisir l'élément de référence parmi 3 éléments:Ceux de gauche,du milieu et de droite.
Nous observons qu'en choisissant l'élément de référence au milieu de la liste à traiter, le temps de tri est le même.

Remarques:

-Si la liste est déja triée,le temps de tri n'augmente pas lorsque l'élément de référence est choisi au milieu,ce qui n'est pas le cas lorsqu'il est choisi à gauche.
-Le programme proposé est récursif.

TriQuick-Sort.xls
Compare Tri

Option Compare Text
Sub essai()
  Dim temp(10000) As Double
  For i = 1 To 10000
     temp(i) = Rnd
  Next i
  t = Timer
  Call tri(temp, 1, 10000)
  MsgBox Timer - t
End Sub

Sub tri(a() As Double, gauc, droi) ' Quick sort
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref: g = g + 1: Loop
      Do While ref < a(d): d = d - 1: Loop
        If g <= d Then
           temp = a(g): a(g) = a(d): a(d) = temp
           g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call tri(a, g, droi)
    If gauc < d Then Call tri(a, gauc, d)
End Sub

Tri avec caractères accentués

Sub tri(a, gauc, droi) ' Quick sort
  ref = sansAccent(a((gauc + droi) \ 2))
  g = gauc: d = droi
  Do
    Do While sansAccent(a(g)) < ref: g = g + 1: Loop
    Do While ref < sansAccent(a(d)): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Function sansAccent(chaine)
  codeA = "ÉÈÊËÔéèêëàçùôûïî"
  codeB = "EEEEOeeeeacuouii"
  temp = chaine
  For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
  Next
  sansAccent = temp
End Function

Tri matriciel

TriMatriciel

La formule matricielle est écrite une seule fois dans un champ.

-Sélectionner D2:D1000
=INDEX(champ;EQUIV(GRANDE.VALEUR(NB.SI(champ;">="&champ);LIGNE(INDIRECT("1:"&LIGNES(champ))));
NB.SI(champ;">="&champ);0))
-Valider avec Maj+ctrl+entrée

-Pour 1.000 éléments, si on modifie une cellule, temps recalcul = 1sec

Fonction liste triée

Cette fonction personalisée matricielle permet d'obtenir une liste triée . Elle est beaucoup +rapide qu'avec une formule matricielle:

-Matricielle :  1.000 éléments --> 1sec
-VBA:              10.000 éléments --> 0,15 sec

Fonction liste triée

Option Compare Text
Function ListeTriée(champ As Range)
  Application.Volatile
  temp = champ.Value
  Dim b()
  ReDim b(1 To Application.Caller.Rows.Count)
  n = 0
  For Each c In temp
     If c <> "" Then
         n = n + 1
         b(n) = c
     End If
  Next
  Call tri(b, 1, n)
  ListeTriée = Application.Transpose(b)
End Function

Tri multi-zones

-Sélectionner E2:E17
=ListeTriéeMZ((A2:A6;A9:A13;A17:A21))
-Valider avec maj+ctrl+entrée

ListeTriéeMultiZones

Function ListeTriéeMZ(champ As Range)
  Application.Volatile
  Dim b()
  ReDim b(1 To Application.Caller.Rows.Count)
  n = 0
  For i = 1 To champ.Areas.Count ' parcours des zones du champ multi-zones
    For j = 1 To champ.Areas(i).Count ' parcours des éléments d'une zone
      If champ.Areas(i)(j) <> "" And champ.Areas(i)(j) <> "." Then
         n = n + 1
         b(n) = champ.Areas(i)(j)
      End If
    Next j
  Next i
  Call Tri(b, 1, n)
  ListeTriéeMZ = Application.Transpose(b)
End Function

Tri multi-feuilles

Tri Multi Feuilles

Tri multi-colonnes

Tri Multi-colonnes
Tri Multi-colonnes 2 col

Sub TriMC()
  Set Rng = Range("A2:A10,C2:C10") ' à adapter
  Dim temp()
  ReDim temp(Rng.Count)
  lig = 0
  For i = 1 To Rng.Areas.Count
    For j = 1 To Rng.Areas(i).Count
     If Rng.Areas(i)(j) <> "" Then
       lig = lig + 1
       temp(lig) = Rng.Areas(i)(j)
     End If
   Next j
  Next i
  Call Tri(temp, 1, lig)
  lig = 0
  For i = 1 To Rng.Areas.Count
    For j = 1 To Rng.Areas(i).Count
      lig = lig + 1
      Rng.Areas(i)(j) = temp(lig)
    Next j
  Next i
End Sub

Autre exemple

Si le champ C6:C41,I6:I41,O6:O41 a été nommé zonetri, on peut remplacer :

Set Rng1 = Range("C6:C41,I6:I41,O6:O41")

Par

Set Rng1 = Range("zonetri")

Ainsi, les champs peuvent être déplacés.

Tri Multi-colonnes 4 col

Tri multi-colonnes

Tri multi-colonnes

Sub Tri3Col()
  Set Rng = [B2:D19]
  Ht = Rng.Rows.Count
  Ncol = Rng.Columns.Count
  Columns(Rng.Column).Insert Shift:=xlToRight
  For c = 1 To Ncol
     Cells(Rng.Row + (c - 1) * Ht, Rng.Column - 1).Resize(Ht).Value = Rng.Columns(c).Value
  Next c
  Rng(1, 1).Offset(, -1).Resize(Ht * Ncol).Sort key1:=Rng.Offset(, -1), Header:=xlNo
  For c = 1 To Ncol
     Rng.Columns(c).Value = Cells(Rng.Row + (c - 1) * Ht, Rng.Column - 1).Resize(Ht).Value
  Next c
  Columns(Rng.Column - 1).Delete
End Sub

Tri négatifs/positifs puis Alpha

Tri les nombres négatifs puis positifs puis dans l'ordre alphabétique à l'intérieur de chaque groupe.

Tri Négatifs Positifs puis Alpha

Sub TriNegPosAlpha()
  Range("c2:c" & [A65000].End(xlUp).Row).FormulaR1C1 = "=RC[-1]>0"
  Range("a2:c" & [A65000].End(xlUp).Row).Sort key1:=[C3], key2:=[A3], Header:=xlNo
  Cells(Application.Match(True, [C:C], 0), 1).Resize(, 2).Borders(xlEdgeTop).Weight = xlThin
  Range("c2:c" & [A65000].End(xlUp).Row).ClearContents
End Sub

Tri sans doublons

Tri sans doublons

Sub classement()
  Set Rng = Range("d2:E" & [D65000].End(xlUp).Row)
  tbl = Rng.Value
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To UBound(tbl)
    d(tbl(i, 1)) = tbl(i, 2)
  Next i
  [G2].Resize(d.Count) = Application.Transpose(d.keys)
  [H2].Resize(d.Count) = Application.Transpose(d.items)
  [G2].CurrentRegion.Sort key1:=[H2], Order1:=xlDescending, Header:=xlNo
End Sub

Tri de plusieurs blocs

Tri de plusieurs blocs

Option Compare Text
Sub Tri()
  début = 1
  Fin = 65000
  Do
    Set result1 = Range(Cells(début, "A"), Cells(Fin, "A")).Find(what:="client")
    If Not result1 Is Nothing Then
       Set result2 = Range(Cells(début, "B"), Cells(Fin, "B")).Find(what:="total client")
       If Not result2 Is Nothing Then
          Set Rng = Range(result1.Offset(1), result2.Offset(-1, 3))
          Rng.Sort Key1:=result1.Offset(1, 4), Order1:=xlDescending, Header:=xlNo
        End If
      End If
      début = result2.Row + 1
    Loop Until result1 Is Nothing
End Sub

Fonction Filtre(champ_données;champ_critère;critère) (Excel 2019)

Fonction Filtre

=FILTRE(Tableau1;Tableau1[Ville]=E2)

Fonction Tri(champ_données;colonneTri) (Excel 2019)

Fonction Tri et Filtre

On peut combiner Filtre() et Tri()

=TRI(FILTRE(Tableau2;Tableau2[Ville]=D2))

Fonction Unique(champ_colonne) (Excel 2019)

=TRI(UNIQUE(A2:A16))

Fonctions personalisées

Fonction tri 1 colonne
Fonction tri une BD
Fonction Filtre une BD avec 2 critères