Discussion :

[cafeine]

Bonjour à tous,

je recherche un solution pour trier un tableau sur une des composantes ...

Code :

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

1
2
3
4
5
6
7
8
Type IRCuser_
 nick as string
 mask as string
 in as boolean
 name as string
End Type
 
Dim utbIRC() as IRCuser_

mon but est de trier ce tableau utbIRC() par "nick" alphabétique.

Merci d'avance pour votre aide.

[KIKI_94]

Salut

Si tu remplis ce tableau par un recordset alors le plus simple serait de trier le Recordset au préalable sinon tu vas devoir monter une usine à gaz.

@+

[SpaceFrog]

Tu as juste une liste à calsser ?
Il te faut donc coller un flexgrid à 1 seule colonne sur ton form.
sans fixedrow ni fixedcol (=o pour les deux)

Puis tu le remplis avec :

for i = 0 to maxlist
mygrid.textmatrix(i,0) = monelementdeliste
next

Puis tu selectionnes la zone trier :

mygrid.sort = 1

A vérifier toutefois car je n'ai pas mon appli avec les tris sous les yeux ...

tu sera peut être obligé de selectionner une zone à trier...

[cafeine]

j'ai essayé de faire un truc qui répond à mon besoin ....

donc si ça intéresse quelqu'un ...

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
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
Option Explicit
 
Type IRC_
    nick As String
    mask As String
    in As Boolean
End Type
 
Private nbTotal As Integer
Dim utbIRC() As IRC_
Dim rutb() As String
 
 
Function SortTab(ByVal orderAZ As Boolean, ByVal strLong As Integer, ByVal TabNb As Integer, ByVal debugZ As Boolean)
' parcours non optimal
' le tri portant sur 499 éléments d'une longueur de 49 caractères a pris 851.5625 ms
' sorttab True, 49, 499, True
 
Dim t0, t1 As Single
Dim i As Integer
Dim j As Integer
Dim iIndex As Integer
Dim CurrentVal As String
 
' charge le tableau de test
InitTab strLong, TabNb, debugZ
 
' démarrage du chrono de tri
t0 = Timer
 
' trouve la fin du tableau
nbTotal = 0
For i = 1 To UBound(utbIRC)
    If Len(utbIRC(i).nick) > 0 Then
        nbTotal = nbTotal + 1
    Else
        Exit For
    End If
Next i
 
' redimensionne le tableau de résultat
ReDim rutb(nbTotal + 1)
 
' reclasse
' parcours le tableau initial
For i = 1 To nbTotal
    For j = 1 To i
        If CompareString(utbIRC(i).nick, rutb(j), orderAZ) = orderAZ Then
            InsertRow j, utbIRC(i).nick
            Exit For
        End If
    Next j
Next i
 
' affiche en mode debug s'il y a lieu
If debugZ Then
    Debug.Print " ========= liste triée ========= "
    For i = 1 To nbTotal
       Debug.Print i, rutb(i)
    Next i
End If
 
t1 = Timer
Debug.Print "le tri portant sur " & nbTotal & " éléments d'une longueur de " & strLong & " caractères a pris " & (t1 - t0) * 1000 & " ms"
 
End Function
 
' crée un tableau avec des valeurs aléatoires
Function InitTab(ByVal strLong As Integer, ByVal NbTab As Integer, debugZ As Boolean)
ReDim utbIRC(NbTab)
Dim i As Integer
Dim j As Integer
 
Randomize
 
For i = 1 To NbTab
 For j = 1 To strLong
    utbIRC(i).nick = utbIRC(i).nick & Chr(Int(Rnd * 25) + 65)
 Next j
 If debugZ Then Debug.Print i, utbIRC(i).nick
Next i
 
End Function
 
' compare la valeur asc des caractères pour déterminer l'ordre alpha
Function CompareString(ByVal Expr1 As String, ByVal Expr2 As String, ByVal orderAZ As Boolean) As Boolean
'?CompareString("ABDCEF","ZZZZZ")
Dim i As Integer
 
If Len(Expr2) = 0 Then
    CompareString = orderAZ
    Exit Function
End If
 
For i = 1 To MinZ(Len(Expr1), Len(Expr2))
 If Asc(Mid(Expr1, i, 1)) < Asc(Mid(Expr2, i, 1)) Then
    CompareString = True
    Exit Function
 ElseIf Asc(Mid(Expr1, i, 1)) > Asc(Mid(Expr2, i, 1)) Then
    CompareString = False
    Exit Function
 End If
Next i
 
End Function
 
 
Function MinZ(ByVal Nbr1 As Integer, ByVal Nbr2 As Integer) As Integer
 
If Nbr1 > Nbr2 Then MinZ = Nbr2 Else MinZ = Nbr1
 
End Function
 
Function MaxZ(ByVal Nbr1 As Integer, ByVal Nbr2 As Integer) As Integer
 
If Nbr1 < Nbr2 Then MaxZ = Nbr2 Else MaxZ = Nbr1
 
End Function
 
'insère un élément à un tableau préexistant
Function InsertRow(ByVal Index As Integer, ByVal NewVal As String)
Dim i As Integer
 
For i = nbTotal - 1 To Index Step -1
    rutb(i + 1) = rutb(i)
Next i
rutb(Index) = NewVal
 
End Function