Discussion :

[logue_in]

Bonjour,

Petite question supplémentaire,

Qu'elle méthode est la plus simple pour trier la colonne 1 de ce tableau (ordre des distances des plus petites aux plus grandes) tout en conservant la correspondance de la colonne 2?

Je m'oriente vers le Quick sort? Y a-t-il plus simple?

[Philippe PONS]

L'ArrayList possède une méthode Sort.
Essaie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

arrList.Sort

EDIT

Non, je viens d'essayer, ça ne marche pas.
Il faut trier le tableau avec QuickSort.

[boisgontierjacques]

Bonjour,

Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Option Compare Text
Private Sub UserForm_Initialize()
 With Sheets("BD")
   a = .Range("A2:C" & .[A65000].End(xlUp).Row).Value
 End With
 Dim tmp(): ReDim tmp(1 To UBound(a))
  For i = LBound(a) To UBound(a)      ' sup lignes vides de a(,)
    If a(i, 1) <> "" Then n = n + 1: tmp(n) = i
  Next
  ReDim Preserve tmp(1 To n)
  a = Application.Index(a, Application.Transpose(tmp), _
    Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")")))
  Call tri(a, LBound(a), UBound(a), 1)
  Me.ListBox1.List = a
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub tri(a, gauc, droi, colTri)             ' Quick sort
 NbCol = UBound(a, 2) - LBound(a, 2) + 1   ' nb de colonnes
 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 c = 1 To NbCol
         temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call tri(a, g, droi, colTri)
 If gauc < d Then Call tri(a, gauc, d, colTri)
End Sub

ou avec ArrayList

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Option Compare Text
Private Sub UserForm_Initialize()
 With Sheets("BD")
   a = .Range("A2:C" & .[A65000].End(xlUp).Row).Value
 End With
 Set AL = CreateObject("System.Collections.ArrayList")
 For i = LBound(a) To UBound(a)
     If a(i, 1) <> "" Then AL.Add Array(a(i, 1), a(i, 2), a(i, 3))
 Next i
 a = Application.Transpose(Application.Transpose(AL.toarray))
 Call tri(a, LBound(a), UBound(a), 1)
 Me.ListBox1.List = a
End Sub

Boisgontier
http://boisgontierjacques.free.fr

[logue_in]

Merci à vous Philippe et Jacques!

Le quick sort fonctionne parfaitement!

Une méthode très ingénieuse!

[boisgontierjacques]

Bonjour,

Suppression de lignes vides dans ListBox triéavec Dictionary (0,2 sec pour 10.000 lignes contre 0,5 sec avec ArrayList)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Option Compare Text
Private Sub UserForm_Initialize()
 Set f = Sheets("BD")
 Set d = CreateObject("Scripting.Dictionary")
 a = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
 For i = LBound(a) To UBound(a)
   If a(i, 1) <> "" Then d(i) = Array(a(i, 1), a(i, 2), a(i, 3))
 Next i
 a = Application.Transpose(Application.Transpose(d.items))
 Call tri(a, LBound(a), UBound(a), 1)
 Me.ListBox1.List = a
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub tri(a, gauc, droi, colTri)             ' Quick sort
 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 c = LBound(a, 2) To UBound(a, 2)
         temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call tri(a, g, droi, colTri)
 If gauc < d Then Call tri(a, gauc, d, colTri)
End Sub

Boisgontier