Discussion :

[DirtyRizer]

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.

[Thautheme]

Bonjour DirtyRizer, bonjour le forum,

Quelle est la ligne qui plante ?
J'exécute ton code pas à pas, je trouve étrange :

Code :

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

While Worksheets("Données").Cells(lignedonnées, 9)

Ne devrait-il pas y avoir une condition "= ..." ? Car on passe directement après la ligne Wend. Et dans ce cas, les tableaux tabLpb, tabSp, tabRp, tabSr, tabLr et tabRr n'ont pas été redimensionnées et par conséquent, la ligne :

Code :

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

tabfinal(i, 1) = tabLp(i)

Plante...

[Philippe Tulliez]

Bonjour Thautheme,

Ne devrait-il pas y avoir une condition "= ..." ? Car on passe directement après la ligne Wend.

Dans la ligne

Code :

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

While Worksheets("Données").Cells(lignedonnées, 9)

La condition est implicite et équivaut à <> 0 donc tant que la cellule de la ligne lignedonnées de la colonne I contiendra une valeur numérique autre que nulle la boucle fonctionnera

Exemple

Code :

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

1
2
3
4
5
Sub t()
 Dim r As Long
 'r = 5
 MsgBox IIf(r, "Valeur =" & r, "Valeur nulle")
End Sub

[DirtyRizer]

Bonjour Thautheme,
En effet merci j'ai corrigé dans le code de mon premier message je veux que ce While s'effectue jusqu'a ce que la colonne 9 de mon tableau soit vide. je vais réessayer le code en ayant juste modifier ça.

[Thautheme]

Re,

Bon, j'ai encore perdu l'occasion de me taire... Merci au Maître TULLIEZ. C'est toujours un plaisir d'apprendre. Toutefois, DirtyRizer, tu n'as toujours pas précisé quelle était la ligne qui plantait...

[DirtyRizer]

Re,

Je viens de mettre la ligne où se trouve mon erreur dans le message de base de la discussion.
Ligne 103. ReDimtabfinal

[Philippe Tulliez]

Bonjour,
A la première lecture rapide de ton code et après que tu aies signalé que c'était la ligne 103 ( ReDim Preserve tabfinal(882, 6) ) qui se mettait en erreur, il semble que tu redimensionnes la première dimension de la varable or le redimensionnement avec Preserve n'est permise que sur la dernière

Voir le tutoriel Utiliser les variables tableaux en VBA Excel et particulièrement le chapitre III-B. Le mot clé Preserve