Creation d'un listbox

Version imprimable

Voir 40 message(s) de cette discussion en une page

Aaaaaaaaah ! Je viens de me prendre la tête ! ^^
Cette histoire de tableau transposé pour pouvoir trier etc... :aie:

Bref, j'ai trouvé sur ce tuto (?), une méthode permettant de trier les tableaux :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Tri(a(), ColTri, gauc, droi) ' 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 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 Tri(a, ColTri, g, droi)
  If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub

Ainsi, je l'appelle dans ma ComboBox1_Change. Mais il faut transposer le tableau car on ne peut pas faire varier dynamiquement une première dimension et le tri ne s'effectue que sur les "colonnes" (vituelles).
Bref, voici, enfin ! :aie:

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
Private Sub ComboBox1_Change()
Dim oRng As Range
Dim oCell As Range
Dim oRng2 As Range
Dim i As Integer, k As Integer
 
Dim Tabl_tri() 'As String
Dim Tabl_tri_transpose()
 
Me.ListBox1.Clear
ListBox1.ColumnCount = 5
ListBox1.ColumnWidths = "30;75;250;75;75"
With Worksheets("TS")
    Set oRng = FindAll(Me.ComboBox1.Value, Union(.Columns(6), .Columns(8), .Columns(10), .Columns(12)), xlFormulas, xlWhole)
 
'****************************** SANS TRI ******************************
'    k = 0
'    For Each oCell In oRng
'        Me.ListBox1.AddItem
'        Set oRng2 = .Range("A" & oCell.Row)
'        Me.ListBox1.List(k, 0) = oRng2
'        For i = 1 To 4
'            If i < 3 Then
'                Me.ListBox1.List(k, i) = oRng2.Offset(0, i)
'            ElseIf i = 4 Then
'                Me.ListBox1.List(k, i - 1) = oRng2.Offset(0, i)
'            End If
'        Next i
'        Me.ListBox1.List(k, 4) = oCell.Offset(0, 1) & " €"
'        k = k + 1
'    Next oCell
'**************************** FIN SANS TRI ****************************
 
'****************************** AVEC TRI ******************************
    k = 0
    For Each oCell In oRng
        ReDim Preserve Tabl_tri(4, k)
        Set oRng2 = .Range("A" & oCell.Row)
        Tabl_tri(0, k) = oRng2
        For i = 1 To 4
            If i < 3 Then
                Tabl_tri(i, k) = oRng2.Offset(0, i)
            ElseIf i = 4 Then
                Tabl_tri(i - 1, k) = oRng2.Offset(0, i)
            End If
        Next i
        Tabl_tri(i - 1, k) = oCell.Offset(0, 1) & " €"
        k = k + 1
    Next oCell
 
    Tabl_tri_transpose = Application.Transpose(Tabl_tri)
    Call Tri(Tabl_tri_transpose(), 1, LBound(Tabl_tri_transpose, 1), UBound(Tabl_tri_transpose, 1))
 
    For k = LBound(Tabl_tri_transpose, 1) To UBound(Tabl_tri_transpose, 1)
        Me.ListBox1.AddItem
        For i = LBound(Tabl_tri_transpose, 2) To UBound(Tabl_tri_transpose, 2)
            Me.ListBox1.List(k - 1, i - 1) = Tabl_tri_transpose(k, i)
        Next i
    Next k
'**************************** FIN AVEC TRI ****************************
End With
 
End Sub

J'espère que ça t'ira ! :ccool:

Cordialement,
Kimy

16/02/2015, 08h46
tiralarc03

Bonjour,

Le code ne marche pas il s'arrete sur cette ligne

Code:

Call Tri(Tabl_tri_transpose(), 1, LBound(Tabl_tri_transpose, 1), UBound(Tabl_tri_transpose, 1))

Bonjour tiralarc03,

Dans le cas où une seule occurrence était présente, cela faisait planter le tri...

Bref, j'ai corrigé cela :

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
Private Sub ComboBox1_Change()
Dim oRng As Range
Dim oCell As Range
Dim oRng2 As Range
Dim i As Integer, k As Integer
 
Dim Tabl_tri() 'As String
Dim Tabl_tri_transpose()
 
Me.ListBox1.Clear
ListBox1.ColumnCount = 5
ListBox1.ColumnWidths = "30;75;250;75;75"
With Worksheets("TS")
    Set oRng = FindAll(Me.ComboBox1.Value, Union(.Columns(6), .Columns(8), .Columns(10), .Columns(12)), xlFormulas, xlWhole)
 
'****************************** SANS TRI ******************************
'    k = 0
'    For Each oCell In oRng
'        Me.ListBox1.AddItem
'        Set oRng2 = .Range("A" & oCell.Row)
'        Me.ListBox1.List(k, 0) = oRng2
'        For i = 1 To 4
'            If i < 3 Then
'                Me.ListBox1.List(k, i) = oRng2.Offset(0, i)
'            ElseIf i = 4 Then
'                Me.ListBox1.List(k, i - 1) = oRng2.Offset(0, i)
'            End If
'        Next i
'        Me.ListBox1.List(k, 4) = oCell.Offset(0, 1) & " €"
'        k = k + 1
'    Next oCell
'**************************** FIN SANS TRI ****************************
 
'****************************** AVEC TRI ******************************
    k = 0
    For Each oCell In oRng
        ReDim Preserve Tabl_tri(4, k)
        Set oRng2 = .Range("A" & oCell.Row)
        Tabl_tri(0, k) = oRng2
        For i = 1 To 4
            If i < 3 Then
                Tabl_tri(i, k) = oRng2.Offset(0, i)
            ElseIf i = 4 Then
                Tabl_tri(i - 1, k) = oRng2.Offset(0, i)
            End If
        Next i
        Tabl_tri(i - 1, k) = oCell.Offset(0, 1) & " €"
        k = k + 1
    Next oCell
 
    Tabl_tri_transpose() = Application.Transpose(Tabl_tri)
 
    If UBound(Tabl_tri, 2) <> LBound(Tabl_tri, 2) Then
        Call Tri(Tabl_tri_transpose(), 1, LBound(Tabl_tri_transpose, 1), UBound(Tabl_tri_transpose, 1))
    End If
 
    For k = LBound(Tabl_tri_transpose, 1) To UBound(Tabl_tri_transpose, 1)
        Me.ListBox1.AddItem
        If UBound(Tabl_tri, 2) <> LBound(Tabl_tri, 2) Then
            For i = LBound(Tabl_tri_transpose, 2) To UBound(Tabl_tri_transpose, 2)
                Me.ListBox1.List(k - 1, i - 1) = Tabl_tri_transpose(k, i)
            Next i
        Else
            Me.ListBox1.List(0, k - 1) = Tabl_tri_transpose(k)
        End If
    Next k
'**************************** FIN AVEC TRI ****************************
End With
 
End Sub

N'hésite pas à revenir vers moi ! :ccool:

Cordialement,
Kimy

16/02/2015, 13h19
tiralarc03

Bonjour,
cela bloque toujours au même endroit :aie:

Bonjour tiralarc03,

Allez, imaginons que tu as un "Option Explicit", mais je n'y crois pas trop...
Remplace la Sub Tri par celle-ci... L'as-tu bien insérée déjà ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Tri(a(), ColTri As Integer, gauc As Integer, droi As Integer) ' Quick sort
Dim ref
Dim g As Integer, d As Integer, k As Integer
Dim temp
 
  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 Tri(a, ColTri, g, droi)
  If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub

Je n'ai plus aucun soucis de mon côté...

Cordialement,
Kimy

Voir 40 message(s) de cette discussion en une page