Quick sort Gros probleme de tri nombre +/- en string

Version imprimable

08/03/2020, 08h50
GESCOM2000

Quick sort Gros probleme de tri nombre +/- en string

Bonjour
Je viens de m’apercevoir d'un problème de tri avec les Quick sort ou autre formule de tri.
Exemple

Dans un array en string

-0.3 -0.2 -0.1 +0.1 +0.2 +1.1 +1.2

call tri en "xlAscending" blabla devrait me sortir
-0.1 -0.2 -0.3 +0.1 +0.2 +1.1 +1.2
Mais il me sort
-0.1 -0.2 -0.3 +1.2 +1.1 +0.2 +0.1

Pourquoi ?

Merci
08/03/2020, 09h18
mfoxy

Bonjour,

Pourrais tu poster le/les codes que tu utilises ?

On pourrait ainsi voir d'où vient le souci, très probablement un problème de déclaration de tes variables.

Bat

J'utilise celui-ci mais avec les autres c'est pareil (code récupérer et rajouté perso pour les dates Option ColTriLaDate)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
Sub Tri(Tablo(), Optional Key1, Optional Sens1 As XlSortOrder = xlAscending, Optional Key2, Optional Sens2 As XlSortOrder = xlAscending, Optional Key3, Optional Sens3 As XlSortOrder = xlAscending, Optional ColTriLaDate)
 
'Option pour les dates en string....
Dim I As Long
If IsMissing(ColTriLaDate) Then else For I = LBound(Tablo) To UBound(Tablo): Tablo(I, ColTriLaDate) = CDate(Tablo(I, ColTriLaDate)): Next I
 
Dim TOrdreKeys(1 To 3), TValKeys()
Dim TabloTemp(), Tidx() As Long, Inb 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 Inb = LBound(Tablo) To UBound(Tablo)
    Tidx(Inb) = Inb
    For j = LBound(TValKeys) To UBound(TValKeys)
      TKeys(Inb, j) = Tablo(Inb, TOrdreKeys(j))
    Next j
  Next Inb
  Call ShellSort(TKeys, Tidx, TValKeys(), LBound(Tablo), UBound(Tablo))
  For Inb = LBound(Tablo) To UBound(Tablo)
    For j = LBound(Tablo, 2) To UBound(Tablo, 2)
      TabloTemp(Inb, j) = Tablo(Tidx(Inb), j)
    Next j
  Next Inb
  Tablo = TabloTemp
 
'La Sub Tri_3_clés permet de trier un Array à 2 dimensions dans un sens ascendant ou descendant avec la possibilité  d'individualiser le sens de tri selon les colonnes.
'
'Les arguments dont dispose la procédure :
'- choix possible parmi 3 clés de tri (arguments 1, 3 et 5) : si aucune clé n'est choisie la clé 1 trie  par défaut à la 1ère colonne
'
'- choix du sens de tri par clé (arguments 2, 4 et 6) : le sens de tri par défaut est ascendant.
'- pour choisir un tri ascendant : xlAscending ou 1
'- pour choisir un tri descendant : xlDescending ou 2
'
'Exemple d 'utilisation :
'Tri de la colonne 1 dans le sens ascendant  (appels de procédure équivalents) :
'Call Tri(Tablo)
'Call Tri(Tablo, 1)
'Call Tri(Tablo, 1, xlAscending)
'Call Tri(Tablo, 1, 1)
'
'Tri de la colonne 4 dans un sens ascendant et de la colonne 1 dans un sens descendant  (appels de procédure équivalents) :
'Call Tri(Tablo, 4, , 1, xlDescending)
'Call Tri(Tablo, 4, , 1, 2)
'Call Tri(Tablo, 4, xlAscending, 1, xlDescending)
'Call Tri(Tablo, 4, 1, 1, 2)
 
'Tri de la colonne 3 dans le sens ascendant, de la colonne 4 dans le sens descendant  et de la colonne 1 dans  le sens ascendant (appels de procédure équivalents) :
'Call Tri(Tablo, 3, xlAscending, 4, xlDescending, 1, xlAscending)
'Call Tri(Tablo, 3, 1, 4, 2, 1, 1)
 
'NB : appel de procédure
'- avec  Call => Call Tri(Tablo, 1, xlAscending)
'- sans Call => Tri Tablo, 1, xlAscending
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

avec un Quick sort

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub TriCol(a, colTri, gauc, droi) 
  'a = Me.ListBox1.List
  'TriCol a, 1, LBound(a, 1), UBound(a, 1)
 
  Ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < Ref: g = g + 1: Loop
    Do While Ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
       For K = LBound(a, 2) To UBound(a, 2)
         Temp = a(g, K): a(g, K) = a(d, K): a(d, K) = Temp
       Next K
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call TriCol(a, colTri, g, droi)
  If gauc < d Then Call TriCol(a, colTri, gauc, d)
End Sub

Hello,

Je viens de tester de mon coté et cette manière de procéder fonctionne.

Pièce jointe 544040

Bàt,

MFoxy

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Sub test()
 
Dim myArray
 
    myArray = Array("-0.3", "-0.2", "-0.1", "0.1", "0.2", "1.1", "1.2")
 
        Debug.Print "Before Sorting"
 
    For Each element In myArray
        Debug.Print element
    Next element
 
    Call BubbleSort(myArray)
 
        Debug.Print "_____________________"
        Debug.Print "After Sorting"
 
    For Each element In myArray
        Debug.Print element
    Next element
 
 
End Sub
 
Sub BubbleSort(arr)
  Dim strTemp As String
  Dim i As Long
  Dim j As Long
  Dim lngMin As Long
  Dim lngMax As Long
  lngMin = LBound(arr)
  lngMax = UBound(arr)
  For i = lngMin To lngMax - 1
    For j = i + 1 To lngMax
      If arr(i) > arr(j) Then
        strTemp = arr(i)
        arr(i) = arr(j)
        arr(j) = strTemp
      End If
    Next j
  Next i
End Sub

08/03/2020, 16h27
GESCOM2000

En fait avec un simple short ca marche !!!!
Je passe ton cote en Array 2D

Comme quoi il faut vraiment tout vérifier quand tu debug...

Merci