Bonjour à tous je fais un bout de code pour lire des valeurs dans un tableau puis les rentrer dans une variable de type Tableau.
Je désire faire un tri juste après mais je ne parviens pas à redimensionner mon tableau vba me met :
"Erreur d'exécution '9';
L'indice n'appartient pas à la sélection."
Mais je ne vois pas d'où cela peut venir je cherche depuis le début de matinée et je n'avance pas...
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
 
Sub Charge_magasin_par_jour()
    Dim lignedonnées, lignetableau, tabtaille, x As Long
    Dim tabLp() As Long
    Dim tabSp() As Long
    Dim tabRp() As Long
    Dim tabSr() As Long
    Dim tabLr() As Long
    Dim tabRr() As Long
    Dim tabdate() As Date
    Dim tabfinal() As String
    Dim inter(1, 7) As String
    Dim datedejarentré As Boolean
    Dim crangé As Boolean
    Dim memo As String
 
 
    lignedonnées = 8
 
    ReDim Preserve tabdate(1)
    tabtaille = 1
    While Worksheets("Données").Cells(lignedonnées, 9) <> ""
        datedejarentré = False
        If UBound(tabdate, 1) - 1 > 0 Then
            For i = 0 To UBound(tabdate, 1) - 1
                If tabdate(i) = Left(Worksheets("Données").Cells(lignedonnées, 9), 10) Then
                    tabLp(i) = tabLp(i) + Worksheets("Données").Cells(lignedonnées, 10)
                    tabSp(i) = tabSp(i) + Worksheets("Données").Cells(lignedonnées, 11)
                    tabRp(i) = tabRp(i) + Worksheets("Données").Cells(lignedonnées, 12)
                    tabSr(i) = tabSr(i) + Worksheets("Données").Cells(lignedonnées, 13)
                    tabLr(i) = tabLr(i) + Worksheets("Données").Cells(lignedonnées, 14)
                    tabRr(i) = tabRr(i) + Worksheets("Données").Cells(lignedonnées, 15)
                    datedejarentré = True
                End If
            Next
        End If
        If datedejarentré = False Then
            ReDim Preserve tabdate(tabtaille)
            ReDim Preserve tabLp(tabtaille)
            ReDim Preserve tabSp(tabtaille)
            ReDim Preserve tabRp(tabtaille)
            ReDim Preserve tabSr(tabtaille)
            ReDim Preserve tabLr(tabtaille)
            ReDim Preserve tabRr(tabtaille)
 
            tabdate(tabligneecrire) = Left(Worksheets("Données").Cells(lignedonnées, 9), 10)
            tabLp(tabligneecrire) = Worksheets("Données").Cells(lignedonnées, 10)
            tabSp(tabligneecrire) = Worksheets("Données").Cells(lignedonnées, 11)
            tabRp(tabligneecrire) = Worksheets("Données").Cells(lignedonnées, 12)
            tabSr(tabligneecrire) = Worksheets("Données").Cells(lignedonnées, 13)
            tabLr(tabligneecrire) = Worksheets("Données").Cells(lignedonnées, 14)
            tabRr(tabligneecrire) = Worksheets("Données").Cells(lignedonnées, 15)
            tabligneecrire = tabligneecrire + 1
            tabtaille = tabtaille + 1
            datedejarentré = True
        End If
        lignedonnées = lignedonnées + 1
    Wend
 
    lignedonnées = 8
    Worksheets("Données").Cells(7, 17) = "Date"
    Worksheets("Données").Cells(7, 18) = "Livraison prévue"
    Worksheets("Données").Cells(7, 19) = "Servis prévus"
    Worksheets("Données").Cells(7, 20) = "Réception prévue"
    Worksheets("Données").Cells(7, 21) = "Servi réelle"
    Worksheets("Données").Cells(7, 22) = "Livraison réelle"
    Worksheets("Données").Cells(7, 23) = "Réception réelle"
 
    'For i = 0 To UBound(tabdate, 1) - 1
    '    With Worksheets("Données")
    '        .Cells(lignedonnées, 17) = tabdate(i)
    '        .Cells(lignedonnées, 18) = tabLp(i)
    '        .Cells(lignedonnées, 19) = tabSp(i)
    '        .Cells(lignedonnées, 20) = tabRp(i)
    '        .Cells(lignedonnées, 21) = tabSr(i)
    '        .Cells(lignedonnées, 22) = tabLr(i)
    '        .Cells(lignedonnées, 23) = tabRr(i)
    '    End With
    '    lignedonnées = lignedonnées + 1
    'Next
 
    tabtaille = 0
    ReDim tabfinal(100000, 6)
    For i = 0 To UBound(tabdate, 1) - 1
        tabfinal(i, 0) = tabdate(i)
        tabfinal(i, 1) = tabLp(i)
        tabfinal(i, 2) = tabSp(i)
        tabfinal(i, 3) = tabRp(i)
        tabfinal(i, 4) = tabSr(i)
        tabfinal(i, 5) = tabLr(i)
        tabfinal(i, 6) = tabRr(i)
    Next
 
    x = 0
    tabtaille = 0
 
    While tabfinal(x, 0) <> ""
        tabtaille = tabtaille + 1
        x = x + 1
    Wend
 
    tabtaille = tabtaille - 1
    ReDim Preserve tabfinal(882, 6)
 
    tabtaille = UBound(tabfinal, 1)
    While crangé = False
        crangé = True
        For i = 0 To tabtaille - 2
            If tabfinal(i, 0) > tabfinal(i + 1, 0) Then
                inter(0, 0) = tabfinal(i, 0)
                inter(0, 1) = tabfinal(i, 1)
                inter(0, 2) = tabfinal(i, 2)
                inter(0, 3) = tabfinal(i, 3)
                inter(0, 4) = tabfinal(i, 4)
                inter(0, 5) = tabfinal(i, 5)
                inter(0, 6) = tabfinal(i, 6)
                tabfinal(i, 0) = tabfinal(i + 1, 0)
                tabfinal(i, 1) = tabfinal(i + 1, 1)
                tabfinal(i, 2) = tabfinal(i + 1, 2)
                tabfinal(i, 3) = tabfinal(i + 1, 3)
                tabfinal(i, 4) = tabfinal(i + 1, 4)
                tabfinal(i, 5) = tabfinal(i + 1, 5)
                tabfinal(i, 6) = tabfinal(i + 1, 6)
                tabfinal(i + 1, 0) = inter(0, 0)
                tabfinal(i + 1, 1) = inter(0, 1)
                tabfinal(i + 1, 2) = inter(0, 2)
                tabfinal(i + 1, 3) = inter(0, 3)
                tabfinal(i + 1, 4) = inter(0, 4)
                tabfinal(i + 1, 5) = inter(0, 5)
                tabfinal(i + 1, 6) = inter(0, 6)
                crangé = False
            End If
        Next
        tabtaille = tabtaille - 1
    Wend
tabtaille = 2
 
End Sub
Mon programme plante à la ligne N°103 pour le redim de tabfinal.