Discussion :

[lps02]

Bonjour les maitres du vba

Voila mon 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
Dim MaListe() As Variant, Tableau() As Variant
Private Sub UserForm_Initialize()
 
Dim s As Object
 
  For Each s In ActiveWorkbook.Sheets
  If s.Name <> "Parametres" And s.Name <> "Page" Then
    Me.LBChoix.AddItem s.Name
    End If
  Next s
  Me.LBChoix.ListIndex = -1
 
End Sub
 
 
 
 
Private Sub LBChoix_Change()
Dim i As Byte, sh As Worksheet, n As Byte
 
ReDim MaListe(0)
ReDim Tableau(0, 4)
With Me.LBChoix
 
 
 
            For i = 0 To .ListCount - 1
               If .Selected(i) = True Then
 
               MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C21:R16C42"
               ReDim Preserve MaListe(UBound(MaListe) + 1)
 
 
 
                   Tableau(UBound(Tableau), 0) = fmChoixFeuille.LBChoix.List(i) & "!R17C25"
                   Tableau(UBound(Tableau), 1) = fmChoixFeuille.LBChoix.List(i) & "!R17C33"
                   Tableau(UBound(Tableau), 2) = fmChoixFeuille.LBChoix.List(i) & "!R18C25"
                   Tableau(UBound(Tableau), 3) = fmChoixFeuille.LBChoix.List(i) & "!R18C33"
                   Tableau(UBound(Tableau), 4) = fmChoixFeuille.LBChoix.List(i) & "!R17C39"
 
                   ReDim Preserve Tableau((UBound(Tableau) + 1), 4)
                End If
            Next i
 
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 ReDim Preserve MaListe(UBound(MaListe) - 1)
Sheets("Saisie (2)").Range("U8:AP16").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
ReDim Preserve Tableau(UBound(Tableau), 4)
 Sheets("saisie (2)").Range("Y17").Consolidate Sources:=Tableau(UBound(Tableau), 0), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
End Sub
Private Sub CmdQuit_Click()
Unload Me
 
End Sub

Voila mon souci : Dans le code suivant, j'ai une erreur de type 9
à la ligne suivante :

Code :

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

 ReDim Preserve Tableau((UBound(Tableau) + 1), 4)

Pouvez vous m'expliquer?

De même, je souhaiterai faire une somme de valeur stockées dans une colonne de cette matrice et faire apparaître le resultat dans une cellule de la feuille ("page (2)")

Je débute avec les matrices et avoue patauger lamentablement.

A vous lire

Cordialement
lps02

[nibledispo]

bonjour,

le "redim préserve" ne concerne que le dernière dimension (la seconde chez toi) or j'ai le sentiment que tu incrémentes la première dimension.

il faudrait que tu fasses une transpose préalable.

cordialement

[Invité]

les variable tableau commence à zéro c'est comme un HLM un bâtiment de 2 étage à 3 niveaux.

Code :

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

1
2
3
4
5
6
dim Tableau(3)
Tableau(0)=1
Tableau(1)=2
Tableau(2) =3
Tableau(Ubound(Tableau)+1) =3  'indice en dehors de la plage
Tableau(Ubound(Tableau)) =3  'OK

de plus on ne peut redimensionner que des Tableau à une dimension.

Code :

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

1
2
3
dim Tableau()
redim preserve Tableau(0)
redim preserve Tableau(1)

Code :

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

1
2
3
dim Tableau()
redim preserve Tableau(0,0)
redim preserve Tableau(1,0) 'erreur

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
Sub test()
Dim Tableau1()
Dim Init As Boolean
For i = 1 To 10
If Init = False Then
    ReDim Tableau1(0, 0)
 
    Init = True
Else
 Tableau1 = tb(Tableau1)
 
End If
Tableau1(UBound(Tableau1), 0) = i
Next
End Sub
Function tb(v)
Dim t()
 ReDim t(UBound(v) + 1, 0)
 For l = 0 To UBound(v)
   t(l, 0) =v( l,0)
 Next
 tb = t
End Function

[lps02]

Merci à vous pour ces réponses rapide. Je pensais pouvoir me simplifier la vie avec un seul tableau mais il faut revoir ma copie en créant un tableau pour chaque "valeur".

Pas grave, l'essentiel est de pouvoir progresser.

Cordialement
lps02

[Invité]

tu peux également faire un tableau sur dimensionné et avec in index de fin pour savoir ou tu en est.

Code :

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

1
2
3
4
5
6
7
8
9
10
dim Tableau(99999,4)
dim I as long
dim Fin as long
for i= 1 to 100
   tableau(fin,4)="toto"
   fin = fin +1
next
 
for i= 0 to Fin
next

[nibledispo]

Bonsoir,

C'est bien de mettre résolu mais ce serait encore mieux de mettre comment afin que les intervenants sachent ce que valait leur contribution et ne meurent pas idiots.

Cordialement,

[Invité]

il a clôture au poste 4 pensent qu'il n'y avait pas de solution hors il y en a car mon dernier post en était une.

Code :

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

1
2
3
4
5
6
7
8
9
dim Tableau(99999,4)
dim I as long
dim Fin as long
for i= 1 to 100
   tableau(fin,4)="toto"
   fin = fin +1
next
 
range(cells(1,1),cells(Fin,4))=Tabeau

[lps02]

Bonsoir à vous rdurupt et nibledispo
Nibledispo, rdurupt a raison lorsqu'il dit que je voulais chercher une autre solution. C'est chose faite et voici mon code.(un peu long peut être mais ça marche.

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
Dim MaListe() As Variant, nbarb As Long, varb As Long, nbp As Long, vp As Long, vbi As Long
Private Sub UserForm_Initialize()
 
Dim s As Object
 
  For Each s In ActiveWorkbook.Sheets
  If s.Name <> "Parametres" And s.Name <> "Page" Then
    Me.LBChoix.AddItem s.Name
    End If
  Next s
  Me.LBChoix.ListIndex = -1
 
End Sub
 
 
 
 
Private Sub LBChoix_Change()
Dim i As Byte, sh As Worksheet, n As Byte
 
ReDim MaListe(0)
 
With Me.LBChoix
 nbarb = 0
 varb = 0
 nbp = 0
 vp = 0
 vbi = 0
 
            For i = 0 To .ListCount - 1
               If .Selected(i) Then
 
               MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C21:R16C42"
               ReDim Preserve MaListe(UBound(MaListe) + 1)
                    With Sheets(fmChoixFeuille.LBChoix.List(i))
                    nbarb = nbarb + .Range("Y17").Value
                    varb = varb + .Range("AG17").Value
                    nbp = nbp + .Range("Y18").Value
                    vp = vp + .Range("AG18").Value
                    vbi = vbi + .Range("AM17").Value
 
                    End With
 
 
                End If
            Next i
 
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 ReDim Preserve MaListe(UBound(MaListe) - 1)
Sheets("Saisie (2)").Range("U8:AP16").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
With Sheets("saisie (2)")
 .Range("Y17").Value = nbarb
 .Range("AG17").Value = varb
 .Range("Y18").Value = nbp
 .Range("AG18").Value = vp
 .Range("AM17").Value = vbi
 End With
End Sub
Private Sub CmdQuit_Click()
Unload Me
 
End Sub

Merci encore pour votre aide qui m'a permis de trouver cette alternative.

Bien cordialement

lps02