Microsoft 365 tri alphabétique particulier

Sub Trier_365()
     Dim aA, aB
   
     With Range("A1").CurrentRegion          'cette plage
          .FormulaR1C1 = "=rand()"           'des valeurs aléatoire
          .Value = .Value                    'remplacer formules par valeurs
          aA = .Value                        'lire vers mémoire

          aB = Application.Sort(aA, 3, -1)   'trier la 3ième colonne de aA "descendant", le résultat est vecteur aB

          'normallement cela s'arrête ici
          'cette ligne est pour vous montrer le résultat
          .Offset(, .Columns.Count + 2).Value = aB     'coller vecteur aB à droite
     End With

End Sub

Sub Trier_Contournement_2016()
     Dim aA, aB
   
     With Range("A1").CurrentRegion          'cette plage
          .FormulaR1C1 = "=rand()"           'des valeurs aléatoire
          .Value = .Value                    'remplacer formules par valeurs
          aA = .Value                        'lire vers mémoire

          With Worksheets.Add                'ajouter une feuille temporairement pour le triage
               With .Range("A1").Resize(UBound(aA), UBound(aA, 2))     'plage avec les mêmes dimensions
                    .Value = aA              'coller votre vecteur
                    .Sort .Cells(1, 3), xlDescending, Header:=xlNo    'trier physiquement
                    aB = .Value              'lire le résultat
               End With
               Application.DisplayAlerts = False
               .Delete                       'supprimer la feuille temporaire
               Application.DisplayAlerts = True
          End With

          'normallement cela s'arrête ici
          'cette ligne est pour vous montrer le résultat
          .Offset(, .Columns.Count + 2).Value = aB     'coller vecteur aB à droite
     End With

End Sub