Bonjour,

Je souhaite trier un tableau (tabl) de valeures selon l'ordre croissant des cellules de la deuxieme colonne.

Le code ci-dessous est issu de ce forum, J'ai essayé d'y inclure une procédure de trie également trouvé sur le forum. Comment faire pour l'adapter?
Merci

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
Option Explicit
 
Sub Gaston64()
'déclaration des variables
Dim f0 As Worksheet, f1 As Worksheet
Dim Cel As Range, MaPlage As Range
Dim Dico As Object, Tabl()
Dim Dico2 As Object
Dim i As Long
Dim Valeur
Dim cible
 
'affectation des objets aux variables
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
Set f0 = Sheets("Mängelliste")
Set f1 = Sheets("temp")
i = 1
 
'Liste sans doublon + Nombre d'occurence + remplissage Tabl des données Col T & U
With f0
    'l'avantage de SpecialCells(xlCellTypeVisible) est d'éviter le test If .Hidden = False Then
    Set MaPlage = .Range("T10", .Range("T" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    For Each Cel In MaPlage                     '<== Boucle
        Dico(Cel.Value) = Dico(Cel.Value) + 1
        ReDim Preserve Tabl(1 To 3, 1 To i)     '<== redimensionnement et enregistrement de la variable tableau
        Tabl(1, i) = Cel.Value                  '<== remplissage tableau dimension 1
        Tabl(2, i) = Cel.Offset(, 6).Value      '<== remplissage tableau dimension 2
        If Cel.Offset(, 6).Value = "" Then
        Tabl(3, i) = 1
        End If
        i = i + 1
    Next Cel
End With
'tri du tableau selon ordre decroissant des valeurs de la colonne2 du Tabl
'Ce morceau de code est certainement à inclure quelque part plus haut, mais où?
 
'    Do
'        Valeur = 0
'        For i = 1 To UBound(Tabl)
'            If Tabl(2, i) < Tabl(2, i + 1) Then
'                cible = Tabl(2, i)
'                Tabl(2, i) = Tabl(2, i + 1)
'                Tabl(2, i + 1) = cible
'                Tabl(1, i + 1) = Tabl(1, i)
'                Valeur = 1
'            End If
'        Next i
'    Loop While Valeur = 1
 
'    For i = 0 To UBound(Tabl)
'        Debug.Print Tabl(1, i)
'        Debug.Print Tabl(2, i)
'    Next i
 
 
'Restitution de la liste sans doublons + Nbre d'occurences
f1.Range("FJ2").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
f1.Range("FK2").Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
'test si date
    'on voit ici l'intérêt d'avoir remplit notre variable tableau
    'dans la boucle ci-dessus
For i = LBound(Tabl, 2) To UBound(Tabl, 2)
    If IsDate(Tabl(2, i)) Then
    'If (Tabl(2, i)) = "" Then
        'si oui le nombre d'occurence = Nbre d'occurence total
        Dico(Tabl(1, i)) = Dico(Tabl(1, i))
        Dico2(Tabl(1, i)) = Dico2(Tabl(1, i))
    Else
        'si pas date ==> nombre d'occurence = Nbre d'occurence - 1
        Dico(Tabl(1, i)) = Dico(Tabl(1, i)) - 1
        Dico2(Tabl(1, i)) = Dico2(Tabl(1, i)) + 1
    End If   
 
 
 
Next i
'restitution du nombre de dates par item de liste
f1.Range("FL2").Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
f1.Range("FM2").Resize(Dico2.Count, 1) = Application.Transpose(Dico2.Items)
'vidage de la mémoire "effacement" des objets déclarés et affectés en début de procédure
Set Dico = Nothing
Set f0 = Nothing
Set f1 = Nothing
Set MaPlage = Nothing
End Sub