Tri de tableau a 2D [Résolu]

[yedid]

Bonjour,

J'ai un tableau (defini par un variant) qui contient 2 colonnes et plusieurs lignes,

Code :

1
2
Dim table as Range
ReDim table(0 To nbLignes, 0 To 1)

J'aimerai pouvoir trier tout le tableau par ordre alphabetique par rapport a la premiere colonne.

Quelqu'un connait-il une fonction developpée pour ca??
(Je ne peux pas passer par le sort de excel pour des raisons de cellules fusionnées etc.. donc j'ai tout récupéré dans un variant)

MErci d'avance

[SilkyRoad]

bonjour


Tu trouveras un exemple à adapter dans ce lien:

http://silkyroad.developpez.com/vba/tableaux/#LII-C


bonne soirée
michel

[philben]

bonjour,

sinon vous pouvez essayer cette fonction :

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
92
93
94
95
96
97
98
99
 
Public Enum eOrdreTri
   eCroissant
   eDecroissant
End Enum
 
Public Enum eTypeVariant
   eTexte
   eBinTexte
   eAutre
End Enum
 
'---------------------------------------------------------------------------------------
' Procédure    : TriTableau2D  [Sub]
' Retour       :
' Version      : 1.0
' Auteur       : P.B. [Philben]
' Création/Maj : 27/08/07
' Objet        : Tri complétement ou partiellement un tableau de Variants selon
'              : un ordre choisi et un type de variant
'              : Tri Shell ayant un bon rapport poids/performance
' Historique   :
'---------------------------------------------------------------------------------------
Public Sub TriTableau2D(ByRef avTab() As Variant, _
                        ByVal eType As eTypeVariant, _
                        ByVal eOrdre As eOrdreTri, _
                        ByVal lNumColTri As Long, _
                        Optional ByVal lLowerBound As Long = -1, _
                        Optional ByVal lUpperBound As Long = -1)
   Dim i As Long, j As Long, k As Long, l As Long, lInc As Long, n As Long
   Dim lMin As Long, lLowerCol As Long, lUpperCol As Long
   Dim avRefLigne As Variant
 
   lLowerCol = LBound(avTab, 2)
   lUpperCol = UBound(avTab, 2)
   If lNumColTri < lLowerCol Or lNumColTri > lUpperCol Then Exit Sub
   If lLowerBound = -1 Then lLowerBound = LBound(avTab)
   If lUpperBound = -1 Then lUpperBound = UBound(avTab)
   n = lUpperBound - lLowerBound + 1
   ReDim avRefLigne(lLowerCol To lUpperCol)
   lInc = 1
   While lInc < n
      lInc = lInc * 3 + 1
   Wend
   While lInc > 1
      lInc = lInc / 3
      lMin = lInc + lLowerBound
      For i = lMin To lUpperBound
         j = i
         k = j - lInc
         l = lLowerCol
         While l <= lUpperCol
            avRefLigne(l) = avTab(j, l)
            l = l + 1
         Wend
         Do While TTCompare(avRefLigne(lNumColTri), avTab(k, lNumColTri), eType, eOrdre)
            l = lLowerCol
            While l <= lUpperCol
               avTab(j, l) = avTab(k, l)
               l = l + 1
            Wend
            j = j - lInc
            If j < lMin Then Exit Do
            k = j - lInc
         Loop
         l = lLowerCol
         While l <= lUpperCol
            avTab(j, l) = avRefLigne(l)
            l = l + 1
         Wend
      Next i
   Wend
End Sub
 
'---------------------------------------------------------------------------------------
' Procédure    : TTCompare   [Function]
' Retour       : Boolean
' Version      : 1.0
' Création/Maj : 27/08/07
' Objet        : Fonction appelée par TriTableau2D pour comparer les valeurs
' Historique   :
'---------------------------------------------------------------------------------------
Private Function TTCompare(ByVal v1 As Variant, ByVal v2 As Variant, _
                           ByVal eType As eTypeVariant, ByVal eOrdre As eOrdreTri) As Boolean
   Dim iRes As Integer
   Select Case eType
   Case eTypeVariant.eTexte
      iRes = StrComp(v1, v2, vbTextCompare)
      TTCompare = (iRes = -1 And eOrdre = eOrdreTri.eCroissant) Xor _
                  (iRes = 1 And eOrdre = eOrdreTri.eDecroissant)
   Case eTypeVariant.eBinTexte
      iRes = StrComp(v1, v2, vbBinaryCompare)
      TTCompare = (iRes = -1 And eOrdre = eOrdreTri.eCroissant) Xor _
                  (iRes = 1 And eOrdre = eOrdreTri.eDecroissant)
   Case Else
      TTCompare = (v1 < v2 And eOrdre = eOrdreTri.eCroissant) Xor _
                  (v1 > v2 And eOrdre = eOrdreTri.eDecroissant)
   End Select
End Function

un test ici :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Private Sub MyTest()
   Dim avTab(1 To 10000, 0 To 1) As Variant
   Dim i As Long, j As Long
   Dim t As Single
   For i = LBound(avTab) To UBound(avTab)
      For j = LBound(avTab, 2) To UBound(avTab, 2)
         avTab(i, j) = Rnd * 100000 \ 1
      Next j
   Next i
   t = Timer()
   TriTableau2D avTab, eTypeVariant.eAutre, eOrdreTri.eDecroissant, 1
Debug.Print vbTab & "Temps : " & (Timer() - t) & "sec"
   For i = LBound(avTab) To 100 'Max 100 pour affichage !
Debug.Print avTab(i, 0), avTab(i, 1)
   Next i
End Sub

cordialement,

Philippe

[yedid]

Ca marche nikel pour la fonction TriTableau2D !
Merci bcp !!