Avis pour contribution - tri Shell 2D - multicritère

[dionys0s]

Salut le forum

j'ai développé, à partir du code trouvé sur cette page, une fonction de tri Shell (infos ici, ici ou encore ici) de variables tableau à 2 dimensions, et je me demandais dans quelle mesure il serait judicieux de la partager.

Cette fonction propose donc, sur une variable tableau, de faire un tri qui peut être :
* Vertical (tri classique qu'on a l'habitude de faire sur des feuilles XL) ou Horizontal (moins commun).
* Trier tout ou une portion seulement de la variable tableau
* Tri croissant / décroissant, avec autant de clé de tri (colonnes pour un tri vertical, lignes pour un tri horizontal) qu'on veut, et dans n'importe quel ordre (par exemple colonne 1, puis 3, puis 2, puis 21 etc...)
* De ne trier qu'une ligne (ou colonne) sur 2, 3, 4 etc... (par exemple, pour un tableau dont les lignes vont par ensemble de plusieurs lignes forcément "solidaires", les lignes solidaires de celle sur laquelle le tri est fait seront déplacées avec cette même ligne. Pas forcément très facile à expliquer, j'espère que ce sera compréhensible dans mon exemple, avec les formats et tout et tout)
* Le tout compatible en Base 0 et 1

Mon fichier exemple comporte un seul onglet qui contient :
* Un tableau 60x30 qui contient les données à trier (on y met exactement ce que l'on veut)
* Un tableau 60x30 qui "réceptionne" le tableau trié.
* Entre les 2 tableau, les paramètres de tri. Ne pas lancer la macro tant que tous les paramètres ne sont pas sur fond vert.
* Les deux tableaux sont mis en forme de manière à lire plus facilement les données pour vérifier la cohérence du tri effectué. Les règles de cette mise en forme, ainsi que des paramètres sont détaillées dans la feuille, à droite du tableau recevant les données triées.

Le code contient 2 modules dont on peut à loisir modifier l'Option Base (l'option Base du module APPELS et le paramètre LBase tablo dans l'onglet doivent cependant être identiques, pour la vérification des paramètres). C'est surtout le code du module "GENERIK" qui est propre, le code du module "APPELS" ayant principalement été développé pour bâtir ce fichier exemple.

Voilà voilà. En gros j'aimerais avoir votre avis sur la qualité de ce "truc", sa fiabilité, son intérêt, les axes d'amélioration, les bugs etc., et surtout s'il est fiable pour être partagé en contribution de ce forum.

Bien à vous
dionys0s

 

[david84]

Re : Avis pour contribution - tri Shell 2D - multicritère

Bonjour,
je n'ai pas regardé ton fichier mais j'avais produit un fichier utilisant le tri de Shell : voir cette discussion
A+

 

[dionys0s]

Re : Avis pour contribution - tri Shell 2D - multicritère

Bonjour David,
re le forum

Effectivement. Mais le module "ShellSort_3_clés" de ton projet est introuvable chez moi (pas de code).
Je ne sais pas si c'est à cause de l'accent et/ou parce que je suis sur mac, mais la fenêtre du module est vraiment bizarre...

 

[david84]

Re : Avis pour contribution - tri Shell 2D - multicritère

Bonjour David,
re le forum

Effectivement. Mais le module "ShellSort_3_clés" de ton projet est introuvable chez moi (pas de code).
Je ne sais pas si c'est à cause de l'accent et/ou parce que je suis sur mac, mais la fenêtre du module est vraiment bizarre...

Ci-joint le code à recopier dans un module :

Option Explicit
Option Compare Text

Sub Tri_3_clés()
Dim Tablo()
Tablo = Range("A2").CurrentRegion.Offset(1) _
.Resize(Range("A2").CurrentRegion.Rows.Count - 1).Value
Call Tri(Tablo, 1, , 2, , 3)
Range("i2").Resize(UBound(Tablo), UBound(Tablo, 2)) = Tablo
End Sub

Sub Tri(Tablo(), Optional Key1, Optional Sens1 As XlSortOrder = xlAscending _
, Optional Key2, Optional Sens2 As XlSortOrder = xlAscending, _
Optional Key3, Optional Sens3 As XlSortOrder = xlAscending)
Dim TOrdreKeys(1 To 3), TValKeys()
Dim TabloTemp(), Tidx() As Long, i As Long, j As Byte
  ReDim TValKeys(1 To 3)
  If IsMissing(Key1) Then Key1 = 1
  TOrdreKeys(1) = Key1: TValKeys(1) = Sens1: j = 1
  If Not IsMissing(Key2) Then TOrdreKeys(j + 1) = Key2: TValKeys(j + 1) = Sens2: j = j + 1
  If Not IsMissing(Key3) Then TOrdreKeys(j + 1) = Key3: TValKeys(j + 1) = Sens3: j = j + 1
  ReDim Preserve TValKeys(1 To j)
  ReDim TabloTemp(LBound(Tablo) To UBound(Tablo), LBound(Tablo, 2) To UBound(Tablo, 2))
  ReDim TKeys(LBound(Tablo) To UBound(Tablo), LBound(TValKeys) To UBound(TValKeys))
  ReDim Tidx(LBound(Tablo) To UBound(Tablo))
  For i = LBound(Tablo) To UBound(Tablo)
    Tidx(i) = i
    For j = LBound(TValKeys) To UBound(TValKeys)
      TKeys(i, j) = Tablo(i, TOrdreKeys(j))
    Next j
  Next i
  Call ShellSort(TKeys, Tidx, TValKeys(), LBound(Tablo), UBound(Tablo))
  For i = LBound(Tablo) To UBound(Tablo)
    For j = LBound(Tablo, 2) To UBound(Tablo, 2)
      TabloTemp(i, j) = Tablo(Tidx(i), j)
    Next j
  Next i
  Tablo = TabloTemp
End Sub

Sub ShellSort(t(), Tidx() As Long, TValKeys(), IdxMin As Long, IdxMax As Long)
Dim c As Byte, i As Long, j As Long, h As Long, Ref(), Lig As Long
ReDim Ref(LBound(TValKeys) To UBound(TValKeys))
h = IdxMin
Do: h = 3 * h + 1: Loop Until h > IdxMax
Do
  h = h / 3
  For i = h + 1 To IdxMax
    For c = LBound(Ref) To UBound(Ref): Ref(c) = t(Tidx(i), c): Next c
    Lig = Tidx(i): j = i
    Do
      For c = LBound(Ref) To UBound(Ref)
        If TValKeys(c) = 1 Then
          If t(Tidx(j - h), c) < Ref(c) Then Exit Do
          If t(Tidx(j - h), c) > Ref(c) Then Exit For
        Else
          If t(Tidx(j - h), c) > Ref(c) Then Exit Do
          If t(Tidx(j - h), c) < Ref(c) Then Exit For
        End If
      Next c
      Tidx(j) = Tidx(j - h): j = j - h
      If j <= h Then Exit Do
    Loop
    Tidx(j) = Lig
  Next i
Loop Until h = IdxMin
End Sub

A+