Demander une correction de code de reconstruction de la matrice

**alidroos** · 31/10/2019, 06h24

Bonjour les professeurs de cet édifice géant

J'ai le code suivant et montre une erreur en partie parce que je ne connais pas la raison pour laquelle j'espère corriger ce code

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
Dim Cll
Private Sub TextBox3_Change()
Dim C, Ck
Dim Cl As Integer
Dim Ar
Dim Arr()
Dim Sh As Worksheet
'------------------------------------------------------------------
Set Sh = Sheets("Sheet2")
 
With Me
    .ListBox1.Clear
    Cl = Val(.ComboBox1.ListIndex + 1)
End With
'------------------------------------------------------------------
With Sh
'------------------------------------------------------------------
Ar = .Range("A4:K" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value
'------------------------------------------------------------------
For i = LBound(Ar, 1) To UBound(Ar, 1)
'------------------------------------------------------------------
If Me.CheckBox1.Value = False Then
Ck = InStr(1, Ar(i, Cl), TextBox3, vbTextCompare)
Else
Ck = (InStr(1, Ar(i, Cl), TextBox3, vbTextCompare) And (CDate(Ar(i, 2)) >= CDate(Me.TextBox1) And CDate(Ar(i, 2)) <= CDate(Me.TextBox2)))
End If
'------------------------------------------------------------------
If Ck Then
ii = ii + 1
    ReDim Preserve Arr(1 To 12, 1 To ii)
    If IsDate(Arr(2, ii)) Then Arr(2, ii) = Format(Arr(2, ii), DtF)
    Arr(1, ii) = Ar(i, 1)
    Arr(2, ii) = Ar(i, 2)
    Arr(3, ii) = Ar(i, 3)
    Arr(4, ii) = Ar(i, 4)
End If
Next i
'------------------------------------------------------------------
If ii Then
'------------------------------------------------------------------
Arm = Untl_A(Application.Transpose(Arr))
'------------------------------------------------------------------
If Cll Then
'Ajouter des lignes au tableau
'------------------------------------------------------------------
ReDim Arr(1 To 12, ii + 1 To (ii + 1 + Cll)) '''<<< Ici montre une erreur
For x = LBound(Arm, 1) To UBound(Arm, 1)
        Arr(1, x) = Arm(1, x)
        Arr(2, x) = Arm(2, x)
        Arr(5, x) = Arm(5, x)
Next x
End If
'------------------------------------------------------------------
Me.ListBox1.Column = Arr
'------------------------------------------------------------------
End If
End With
End Sub
Private Function Untl_A(Ar) As Variant
Dim A
Dim Ws As Worksheet
Dim Nw_Arr()
Dim Nw
Dim Aa
Dim i, ii
Set Ws = Sheets("Sheet1")
With Ws
A = .Range("B4:F" & .Cells(.Rows.Count, "D").End(xlUp).Row).Value
r = UBound(Ar, 1) + 1
lc = UBound(Ar, 2)
For i = LBound(Ar, 1) To UBound(Ar, 1)
    Nw = Ar(i, 1)
    For ii = LBound(A, 1) To UBound(A, 1)
    If InStr(1, A(ii, 2), Ar(1, i)) Then
       If A(ii, 2) <> "" Then
        Cll = Cll + 1
        ReDim Preserve Nw_Arr(1 To r, 1 To Cll)
         Nw_Arr(1, Cll) = A(ii, 1)
         Nw_Arr(2, Cll) = A(ii, 2)
         Nw_Arr(5, Cll) = A(ii, 5)
       End If
    End If
    Next ii
Next i
If Cll Then Untl_A = Nw_Arr
End With
End Function

**Menhir** · 31/10/2019, 08h55

Envoyé par alidroos

J'ai le code suivant et montre une erreur

Quel est le message d'erreur ?
Quelle ligne de code est désignée par le débugage ?

**alidroos** · 31/10/2019, 12h12

Merci d'avoir interagi avec moi

Le message d'erreur apparaît dans cette partie du code

Code :

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

1
2
3
4
5
6
7
8
9
10
If Cll Then
'Ajouter des lignes au tableau
'------------------------------------------------------------------
ReDim Arr(1 To 12, ii + 1 To (ii + 1 + Cll)) '''<<< Ici montre une erreur
For x = LBound(Arm, 1) To UBound(Arm, 1)
        Arr(1, x) = Arm(1, x)
        Arr(2, x) = Arm(2, x)
        Arr(5, x) = Arm(5, x)
Next x
End If

**tony76** · 31/10/2019, 12h23

Bonjour,

Tu as oublié le message d'erreur. (que dit le message ?)

**Menhir** · 31/10/2019, 13h28

Envoyé par alidroos

Le message d'erreur apparaît dans cette partie du code

Code :

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

ReDim Arr(1 To 12, ii + 1 To (ii + 1 + Cll)) '''<<< Ici montre une erreur

La limite inférieure du second indice est incorrecte.
Voir l'aide de ReDim : https://docs.microsoft.com/fr-fr/off...edim-statement

[ lowerTo ] upper [ , [ lowerTo ] upper ] . . .
Lorsque pas explicitement indiqué dans lower, la limite inférieure d’une matrice est contrôlée par la déclaration** Option Base **. La limite inférieure correspond à zéro si aucune instructionOption Base n’est présente.

De plus, Cll n'est pas typé dans sa déclaration et j'ai bien l'impression qu'il n'est pas non plus renseigné.
Donc, la limite max aussi me semble douteuse (ainsi que le If qui précède).

**alidroos** · 31/10/2019, 16h17

Professeur Menhir

Malheureusement, j'ai ajouté les lignes que j'ai mentionnées, l'erreur persiste

Voir la pièce jointe sur laquelle je travaille, j'espère trouver une solution. Merci