Algorithme de Tri pour Tableau multidimension

**rabbitnator3000** · 13/06/2012, 09h16

Au risque de passer pour un gros debutant(que je suis

), lorsrque j'essai d'uttiliser un des deux algorithme de cette discussion, une erreur m'ai renvoyer quand je veu lancer la fonction: "compile error: type mismatch: array or user/define expected"
Si je comprend bien, la fonction attend un tableau en entree mais n'en trouve pas.
Le hic, c'est que je lui donne bien un tableau en entree....
Je precise que le tableau contient des nombre et des chaines de caractere, si jamais ca change quelque chose

merci d'avance pour votre aide

**ZebreLoup** · 13/06/2012, 09h28

Mon avis personnel (ou je sais on s'en fout), c'est qu'un ficher Excel avec 365000 lignes, c'est pas beau ! Il faut peut-être s'intéresser aux bases de données...

(Je suis un rétrograde qui bénit l'époque Excel 2003)

**rabbitnator3000** · 13/06/2012, 09h31

ca m aide pas, et en plus mon fichier n'aura que au grand maximum 1000 lignes

**ZebreLoup** · 13/06/2012, 10h36

Ma remarque était plutôt destinée à l'initiateur(trice) de cette discussion. Pour ton problème, il faudrait que tu donnes le code que tu utilises pour qu'on puisse voir ce qui cloche.

**rabbitnator3000** · 13/06/2012, 10h45

autant pour moi.
dis en passant je suis toujours sur excel 2003

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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
Option Base 1
Option Explicit
Option Compare Text
 
Public rCell
Dim ArrayFromFollowUp()
 
Sub synthese_test()
 
Dim end_line            As Range
Dim fo_test            As Object
Dim fo_testColumn      As String
 
Dim CollFromFollowUp    As New Collection
 
 
Dim i                   As Integer
Dim FoundNA             As Variant
 
 
    With ThisWorkbook.Sheets("Follow_up")
 
        On Error Resume Next
        'to show all data on the sheet (if filter is on there can be a problem to make a copmplete collection)
        .ShowAllData
 
        'if you want to use this object you have to name the cell - for example fo_test
        Set fo_test = .Range("fo_test")
 
        'this is important for end line of the list. Here I get the name of the column -> "K:K"
        fo_testColumn = Chr(fo_test.Column + 64) & ":" & Chr(fo_test.Column + 64)
 
        'these two rows are for end line (end_line is a object). end_line.row is the last row of the list
        Set end_line = .Range(fo_testColumn).Cells(.Range(fo_testColumn).Cells.Count)
        If IsEmpty(end_line) Then Set end_line = end_line.End(xlUp)
 
        'here I created a non duplicit collection (from the sheet follow up)
        For i = fo_test.Row + 1 To end_line.Row
 
            With .Cells(i, fo_test.Column)
                If .Value <> "" Then
                    On Error Resume Next
                    CollFromFollowUp.Add .Value, CStr(.Value)
                End If
            End With
 
        Next i
 
        'here is a two dimension array
        ReDim ArrayFromFollowUp(CollFromFollowUp.Count, 2)
 
        'I filled the array from the collection
        For i = 1 To CollFromFollowUp.Count
 
            ArrayFromFollowUp(i, 1) = CollFromFollowUp(i)
 
        Next i
 
 
        'here you can sort the array - now is doesn't work right....
        ShellSort ArrayFromFollowUp
 
        'here you go through the list and try to find the values from the list in the array.
        'if the value is in the array the value in second dimension I increase the value
        For i = fo_test.Row + 1 To end_line.Row
 
            FoundNA = ItemIndexInArray(ArrayFromFollowUp, .Cells(i, fo_test.Column).Value)
            If FoundNA <> "N/A" Then ArrayFromFollowUp(FoundNA, 2) = ArrayFromFollowUp(FoundNA, 2) + 1
 
            'check if it color correspond to a test which is does only on odd or even year
            If .Cells(i, fo_test.Column).Interior.ColorIndex = 44 And Year(Now()) Mod 2 <> 0 Then ArrayFromFollowUp(FoundNA, 2) = ArrayFromFollowUp(FoundNA, 2) - 1
            If .Cells(i, fo_test.Column).Interior.ColorIndex = 36 And Year(Now()) Mod 2 = 0 Then ArrayFromFollowUp(FoundNA, 2) = ArrayFromFollowUp(FoundNA, 2) - 1
 
        Next i
 
    End With
    With ThisWorkbook.Sheets("synthese")
        .Range("a3:b1000").ClearContents
        For i = 3 To CollFromFollowUp.Count + 2
 
            .Cells(i, 1).Value = ArrayFromFollowUp(i - 2, 1)
            .Cells(i, 2).Value = ArrayFromFollowUp(i - 2, 2)
 
        Next i
 
    End With
 
End Sub
 
' Tri de Shell - Shell Sort
'
Public Sub ShellSort(t() As Long, _
                    Optional ByVal loBound As Long = -1, _
                    Optional ByVal upBound As Long = -1)
 
    Dim i As Long, j As Long, h As Long, v As Long
 
    If loBound = -1 Then
        loBound = LBound(t())
    End If
    If upBound = -1 Then
        upBound = UBound(t())
    End If
 
    h = loBound
    Do
        h = 3 * h + 1
    Loop Until h > upBound
 
    Do
        h = h / 3
        For i = h + 1 To upBound
            v = t(i): j = i
            Do While t(j - h) > v
                t(j) = t(j - h): j = j - h
                If j <= h Then
                    Exit Do
                End If
            Loop
            t(j) = v
        Next i
    Loop Until h = loBound
End Sub
 
'quick algorithm for search in array (it can be a not sorted array)
Function ItemIndexInArray(Arr, Look)
Dim i
Dim k
Dim Item
 
    ItemIndexInArray = "N/A"
    i = 0
    k = 0
 
    For Each Item In Arr
        i = i + 1
        If Arr(i, 1) = Look Then
            ItemIndexInArray = i + k
            Exit For
        End If
    Next Item
 
End Function