Je craque je ne trouve pas de solution simple et je commence à désespérer!!
J'ai modifié pour arriver à une fonction de tri mono-dimensionnel
j'ai concaténé mes trois colonne en une seul et modifier le code pour test que le premier élément de la concaténation
- Code : Tout sélectionner
Sub SortShell(vrTable As Variant)
'Tri par shell par ordre croissant
'Déclaration Variables
Dim nbUbound As Long
Dim nbLbound As Long
Dim nbGap As Long
Dim i As Long
Dim J As Long
Dim vrValue As Variant
On Error Goto ErreurHandle
nbLbound = Lbound(vrTable)
nbUBound = Ubound(vrTable)
If nbUBound = nbLbound Then
'si 1 seule donnée pas de traitement
Exit Sub
Elseif nbUBound = (nbLbound+1) Then
'si uniquement 2 données
If Cdbl(Strleft(vrTable(nbLbound), ";")) > Cdbl(Strleft(vrTable(nbUBound), ";")) Then
vrValue = vrTable(nbUBound)
vrTable(nbUBound) = vrTable(nbLbound)
vrTable(nbLbound) = vrValue
vrValue = Null
End If
Exit Sub
End If
nbGap = nbLbound
Do
nbGap = (3 * nbGap) + 1
Loop Until nbGap > nbUbound
Do
nbGap = nbGap \ 3
For i = nbGap + nbLbound To nbUbound
vrValue = Cdbl(Strleft(vrTable( i ) , ";"))
J = i - nbGap
Do While (Cdbl(Strleft(vrTable(J), ";")) > vrValue)
vrTable( J + nbGap ) = vrTable( J )
J = J - nbGap
If J < nbLbound Then
Exit Do
End If
Loop
vrTable( J + nbGap ) = vrTable( i )
vrValue = Null
Next
Loop Until nbGap = 1
Exit Sub
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub
End Sub
Mon souci est le suivant je lui donne la liste suivante
184,14;465,86;s
84,31;565,69;l
65,43;715,43;xl
218,5;868,5;xxl
Mais une fois le tri fait on a :
84,31;565,69;l
65,43;715,43;xl
184,14;465,86;s
218,5;868,5;xxl
au lieu de
65,43;715,43;xl
84,31;565,69;l
184,14;465,86;s
218,5;868,5;xxl
Une idée ?