XL 2016 VBA Tableau de Tableaux - Syntaxe

[Dudu2]

Bonjour,

Je n'y arrive pas, rien à faire.
Je veux créer un tableau de tabeaux de variants.

Sub a()
    Dim t1() As Variant
   
    ReDim t1(1 To 2)
    redim t1(1) (1 to 3, 1 to 1) <- Syntaxe en erreur !
End Sub

Edit: la seule manière que j'ai trouvée de le faire c'est d'affecter un Range:

t1(1) = ActiveSheet.Range("A1:A3").Value

Mais c'est un pis aller nullissime.
Merci pour l'aide.

 

[sylvanu]

Bonjour Dudu,
Le second redim étant en minuscule, cela signifie que VBA ne comprend pas.
Essayez :

Sub a()
    Dim t1() As Variant
    ReDim t1(1 To 2)
    ReDim t1(1 To 3, 1 To 1) '<- Pas d'erreur !
End Sub

 

[Dudu2]

Bonjour Sylvanu,
Et merci pour ta proposition.
Mais là tu définis un simple tableau à 2 dimensions.

Ce que je voudrais c'est un tableau dont chaque élément contient un autre tableau.
Par exemple ce qu'on obtient en faisant ça, sauf que je voudrais ne pas passer par un Range pour définir le sous-tableau.

Sub a()
    Dim t1() As Variant
 
    ReDim t1(1 To 2)
 
    t1(1) = [A1:A3].Value
    t1(2) = [C1:C3].Value
 
    MsgBox t1(1)(3, 1)    '-> A3
    MsgBox t1(2)(2, 1)    '-> C2
End Sub

 

[sylvanu]

Oups, désolé, je n'avais pas compris.
Mais pour moi Redim permet de redimensionner un array et non un élément de l'array car tous les éléments sont censés avoir la même dimension.

Instruction ReDim (VBA)

Rubrique de référence sur Office VBA

docs.microsoft.com

Je ne suis pas sur que VBA sache le faire avec Redim.

 

[Dudu2]

Tu as sans doute raison.
Reste plus qu'à passer par une structure pour définir directement les dimensions.

Type Tableau
    t() As Variant
End Type

Sub a()
    Dim t1() As Tableau
   
    ReDim t1(1 To 2)
    ReDim t1(1).t(1 To 3, 1 To 1)
End Sub

 

[laurent950]

Bonjour,

Voici la solution : je tiens à remercier @patricktoulon qui m'a appris à travailler avec ce type de tableau imbriqué et don il détenait la solution pour faire fonctionner ce genre de structure assez complexe

Pour ma part j'ai interprété, est essayer de résoudre votre problématique.

Je poste le lien de la discussion qui peut vous servir

https://www.excel-downloads.com/thr...eur-9-indice-hors-plage.20043874/page-3#posts

Aussi @patricktoulon est en mesure de comprendre cette Erreur 2015, pour ma part c'est lié à un manque de données (aucune valeur a la création qui est en liens avec Evaluate) mais j'en suis pas sur

Puis avec une équivalence d'un Redim Preserve (sans en être un) exemple pour t1(1) ajouter de 3 Colonnes pour Test (sans y perdre les données précédemment remplies) le code fonctionne mais il y a une autre Erreur 2023 je n'ai pas la connaissance de ce type d'erreur mais cela ne semble pas affecter les données.

le mieux c'est d'éviter les Erreurs, si vous avez la solution c'est avec plaisir de découvrir cette nouvelle astuce.

Remerciment à @patricktoulon qui a trouvé la solution à ce principe de redimensionnement de tableau emboités.

Sub a()
    Dim t1() As Variant
        ReDim t1(1 To 2)
    ' Redimension de la premiére case du tableau t1(1)
    ' ReDim t1(1).t(1 To 3, 1 To 1)
    Dim AryColumns As Variant
        'Evaluate("ROW(1:" & "3" & ")") = Array(1, 2, 3) ' ........................ 1 To 3
        arrcolumns = Array(1) ' .................................................. 1 To 1
    ' Methode ci-dessous
        t1(1) = Application.Index(t1(1), Evaluate("ROW(1:" & "3" & ")"), arrcolumns)
        ' il y a une Erreur 2015 "Pour chaque case a la creation de" : t1(1)(1, 1) / t1(1)(2, 1) / t1(1)(2, 1)
        ' Mais il n'y a pas d'erreur lorsque l'on remplis c'est même case
        ' Voir ci dessous
            t1(1)(1, 1) = "Case1"
            t1(1)(2, 1) = "Case2"
            t1(1)(3, 1) = "Case3"
        ' Le tableau de tabeaux de variants créer t1(1 To 2)
        ' Contient bien le tableau emboité t1(1)
        ' Dont la dimmenssion est bien égale a 3 Lignes pour 1 colonne
        ' ReDim t1(1).t(1 To 3, 1 To 1)
        ' Lecture des cases du tableau t1
            For i = LBound(t1(1)) To UBound(t1(1))
                Debug.Print t1(1)(i, 1) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1
            Next i
        ' Equivalent d'un Redim Preserve cf ci-dessous
        ' Ajout de 3 colonnes complémentaire a t1(1) pour test (Comme un Redim Preserve)
        ' ------------------------------------------------------------
        arrcolumns = Array(1, 2, 3, 4) ' .................................................. 1 To 4
        t1(1) = Application.Index(t1(1), Evaluate("ROW(1:" & "3" & ")"), arrcolumns)
        ' Pour Test on allimente la colonne 4 créer
        ' ' il y a une Erreur 2023 "Pour chaque case a la creation de" : nouvelle dimension de colonnes (Les 3 Ajoutés)
        ' Voir ci dessous
            t1(1)(1, 4) = "Case1 --->> Colonne 4"
            t1(1)(2, 4) = "Case2 --->> Colonne 4"
            t1(1)(3, 4) = "Case3 --->> Colonne 4"
        ' Lecture des cases du tableau t1
            For i = LBound(t1(1)) To UBound(t1(1))
                Debug.Print t1(1)(i, 1) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 "Case1"/"Case2"/etc.
                Debug.Print t1(1)(i, 2) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 "Erreur 2023"/"Erreur 2023"/etc.
                Debug.Print t1(1)(i, 3) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 "Erreur 2023"/"Erreur 2023"/etc.
                Debug.Print t1(1)(i, 4) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 "Case1 --->> Colonne 4"/"Case2 --->> Colonne 4"/etc.
            Next i
End Sub

Laurent950

 

[laurent950]

Re

Solution Bis sans la gestion les erreurs mais en passant par un tableau Temporaire.

Sub a()
    Dim t1() As Variant
        ReDim t1(1 To 2)
    ' Redimension de la premiére case du tableau t1(1)
    ' ReDim t1(1).t(1 To 3, 1 To 1)
    Dim Ttemp() As Variant
        ReDim Ttemp(1 To 3, 1 To 1)
    ' Methode ci-dessous
        t1(1) = Ttemp
        Erase Ttemp
        ' il n y a plus l' Erreur 2015 "Pour chaque case a la creation de" : t1(1)(1, 1) / t1(1)(2, 1) / t1(1)(2, 1)
        ' Donc lorsque l'on remplis c'est même case c'est correcte : les cases sont vide
        ' Voir ci dessous
            t1(1)(1, 1) = "Case1"
            t1(1)(2, 1) = "Case2"
            t1(1)(3, 1) = "Case3"
        ' Le tableau de tabeaux de variants créer t1(1 To 2)
        ' Contient bien le tableau emboité t1(1) "Qui a était allimenté par le tableau temporaire "Ttemp"
        ' Dont la dimmenssion est bien égale a 3 Lignes pour 1 colonne
        ' ReDim t1(1).t(1 To 3, 1 To 1)
        ' Lecture des cases du tableau t1
            For i = LBound(t1(1)) To UBound(t1(1))
                Debug.Print t1(1)(i, 1) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1
            Next i
        ' Ajout de 3 colonnes complémentaire a t1(1) pour test
            Ttemp = t1(1)
            ReDim Preserve Ttemp(LBound(Ttemp, 1) To UBound(Ttemp, 1), LBound(Ttemp, 2) To 4)
            t1(1) = Ttemp
            Erase Ttemp
            ' ci-dessus on peux en créer une fonction
        ' Pour Test on allimente la colonne 4 créer
        ' ' il n'y a plus l'Erreur 2023 "Pour chaque case a la creation de" : nouvelle dimenssion de colonnes (Les 3 Ajoutées)
        ' Voir ci dessous
            t1(1)(1, 4) = "Case1 --->> Colonne 4"
            t1(1)(2, 4) = "Case2 --->> Colonne 4"
            t1(1)(3, 4) = "Case3 --->> Colonne 4"
        ' Lecture des cases du tableau t1
            For i = LBound(t1(1)) To UBound(t1(1))
                Debug.Print t1(1)(i, 1) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 "Case1"/"Case2"/etc.
                Debug.Print t1(1)(i, 2) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 ""/""/etc.
                Debug.Print t1(1)(i, 3) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 ""/""/etc..
                Debug.Print t1(1)(i, 4) ' ................... i = les lignes du tableau t1(1) Imbriqué dans le tableau t1 "Case1 --->> Colonne 4"/"Case2 --->> Colonne 4"/etc.
            Next i
End Sub

 

[Dudu2]

Bonjour @laurent950,

Merci pour ton retour.
Je n'ai pas compris la 1ère solution qui me parait bien tarabiscotée.

J'avais essayé la solution du tableau temporaire sans succès mais j'ai dû buguer quelque part.
Évidemment il faut le dimensionner avant son affectation car après la syntaxe du Redim ne le rend plus accessible au Redim.

C'est toujours mieux que les structures, même si d'un point de vue clarté du code, une structure permet bien de montrer le regroupement des informations.

Sub a()
    Dim t1() As Variant
    Dim t2() As Variant
 
    ReDim t1(1 To 2)
    ReDim t2(1 To 3, 1 To 1)
    t2(1, 1) = 11
    t2(2, 1) = 21
    t2(3, 1) = 31
    t1(1) = t2
  
    MsgBox t1(1)(2, 1)  '-> 21
End Sub

 

[Dudu2]

Si les Redim ne semblent pas accessibles, les LBound & UBound le sont:

Sub a()
    Dim t1() As Variant
    Dim t2() As Variant
 
    ReDim t1(1 To 2)
    ReDim t2(1 To 3, 1 To 1)
    t1(1) = t2
 
    MsgBox UBound(t1(1), 1) '-> 3
End Sub

 

[laurent950]

Re

J'avais essayé la solution du tableau temporaire sans succès mais j'ai dû buguer quelque part.

Oui c'est complexe quand même.
votre t2 c'est le tableau temporaire en quelque sorte.

' J'ai poussé pour la démo Test
Voici la solution

' J'ai découvert les modules de classe associé à la variable collection pour faire la même chose c'est nettement plus puissant et performant mais d'un niveau encore bien plus complexe.
@Dranreb (Merci Dranred) maitrise cela a la perfection et moi j'apprends c'est le top j'ai abandonné ce système que je vous montre mais je le maitrise quand même.

Comparaison des dictionnaires, des collections et des tableaux​

https://stackoverflow.com/questions/32479842/comparison-of-dictionary-collections-and-arrays

Sub a()
    Dim t1() As Variant
        ReDim t1(1 To 2)
    Dim t2() As Variant
        ReDim t2(1 To 3, 1 To 1)
    t1(1) = t2
    t1(1)(1, 1) = 21  '-> 21
    t1(1)(3, 1) = 31  '-> 31
    '
        t1(1)(2, 1) = t2  '-> Le Tableau t2 est vide
        t1(1)(2, 1)(1, 1) = "A" '-> "A"
        t1(1)(2, 1)(2, 1) = "B" '-> "B"
        t1(1)(2, 1)(3, 1) = "C" '-> "C"

    ' Lecture directe
    MsgBox t1(1)(1, 1)  '-> 21
 
        ' Lecture avec Boucle
        For i = LBound(t1(1), 1) To UBound(t1(1), 1)
            If i <> 2 Then            ' -> Sauf la case 2 qui contient le tableau
                MsgBox t1(1)(i, 1)    ' -> Lecture des Case 1 et 3
            End If
        Next i
     
        ' Lecture avec Boucle
        For i = LBound(t1(1)(2, 1), 1) To UBound(t1(1)(2, 1), 1)
                MsgBox t1(1)(2, 1)(i, 1)    ' -> t1(1)(2, 1) = t2  '-> Le Tableau t2 allimenté
        Next i
 
    ' Lecture directe
    MsgBox t1(1)(3, 1)  '-> 31
 
    ' Bonus
    ' Redim Preserve ->     ' t1(1)(2, 1)
      arrcolumns = Array(1, 2) ' Pour ajout d'une colonne
     ' Si j'avais voulu 5 colonnes -> arrcolumns = Array(1, 2, 3, 4, 5)
     ' Simule des lignes -> équivalent de cases (Pour la première dimension)
     ' Si j'avais voulu 10 cases -> Il faut simulé 10 Ligne / Evaluate("ROW(1:" & "10" & ")")
     ' Ci-Dessous la l'ajout / Equivalent de Redim Preserve
     t1(1)(2, 1) = Application.Index(t1(1)(2, 1), Evaluate("ROW(1:" & "3" & ")"), arrcolumns)
    ' Resultat
     ' t1(1)(2, 1) pas de t1(1)(1 To 3, 1 To 1) a t1(1)(1 To 3, 1 To 2)
  
     ' Test remplir les cases du ou des tableaux : ci-dessous
     ' Je remplis la nouvelle colonne
        t1(1)(2, 1)(1, 2) = "Nouvelle Colonne A" '-> "Nouvelle Colonne A"
        t1(1)(2, 1)(2, 2) = "Nouvelle Colonne B" '-> "Nouvelle Colonne B"
        t1(1)(2, 1)(3, 2) = "Nouvelle Colonne C" '-> "Nouvelle Colonne C"
   
    ' Les dimensions
      LBound(t1(1)(2, 1), 1)  ' -> Dimension 1 soit Première case "Ligne"
      UBound(t1(1)(2, 1), 1)  ' -> Dimension 1 soit Dernière case "Ligne"
      LBound(t1(1)(2, 1), 2)  ' -> Dimension 2 soit Première case "Colonne"
      UBound(t1(1)(2, 1), 2)  ' -> Dimension 2 soit Dernière case "Colonne"

     ' Lecture avec Boucle
        For i = LBound(t1(1)(2, 1), 1) To UBound(t1(1)(2, 1), 1)
            For j = LBound(t1(1)(2, 1), 2) To UBound(t1(1)(2, 1), 2)
                MsgBox t1(1)(2, 1)(i, j)    ' -> t1(1)(2, 1) = t2  '-> Le Tableau t2 allimenté avec la nouvelle colonne
            Next j
        Next i
End Sub

 

[Bernard_XLD]

Bonsoir le fil, le forum

Dudu2, j'avoue ne pas bien comprendre le problème, je loupe peut être quelque chose mais à tout hasard, pourquoi rester sur un tableau à deux dimensions ?
Un tableau à 3 dimensions ne fait pas l'affaire ?

Bien cordialement, @+

Sub a()
    Dim t1() As Variant
 
    ReDim t1(1 To 2)
    ReDim t1(1 To 2, 1 To 3, 1 To 1)
End Sub

 

[Dudu2]

Bonjour @Yeahou,
Oui un tableau à 3 dimensions est une option. Mais les dimensions sont alors toutes fixes.
Dans un tableau de tableaux, les tableaux sont quelconques.

Sub a()
    Dim t1() As Variant
    Dim t2() As Variant
 
    ReDim t1(1 To 2)
    ReDim t2(1 To 3, 1 To 1)
    t1(1) = t2
    ReDim t2(1 To 6)
    t1(2) = t2
 
    MsgBox UBound(t1(1), 1) '-> 3
    MsgBox UBound(t1(2), 1) '-> 6
End Sub

Si on l'applique à un Range multi-Areas, ça permet de stocker les Areas dans leurs dimensions exactes. Car on ne peut pas affecter directement un Range multi-Areas à un tableau (seule la 1ère Area sera prise en compte).

Sub a()
    Dim t1() As Variant
    Dim i As Integer
    Const MultiArea = "A1:A3,C1:C6"
    
    t1 = Range(MultiArea).Value
    MsgBox UBound(t1, 1)    '-> 3
    
    ReDim t1(1 To Range(MultiArea).Areas.Count)
    
    For i = 1 To Range(MultiArea).Areas.Count
        t1(i) = Range(MultiArea).Areas(i).Value
    Next i
 
    MsgBox UBound(t1(1), 1) '-> 3
    MsgBox UBound(t1(2), 1) '-> 6
    MsgBox t1(2)(4, 1)      '-> C4
End Sub

 

[laurent950]

Bonjour,

SI on peut affecter directement un Range multi-Areas à un tableau (les Area sont prises en compte).

Sub a()
Dim t1() As Variant
Dim i As Integer
Const MultiArea = "A1:A3,C1:C6"
t1 = Range(Range(Multiarea).Areas.Item(1),Range(Multiarea).Areas.Item(2))
MsgBox UBound(t1, 1) '-> 6
MsgBox t1(4, 3) '-> C4
End Sub

 

[Dudu2]

Bonjour @laurent950,

Certes tu peux mais il fait un genre de "super-set" des Ranges. Et là faut bien cogiter pour adresser les valeurs.

Sub a()
    Dim t1() As Variant
    Dim i As Integer
    Dim j As Integer
    Dim S As String
    Const MultiArea = "A1:A3,C1:C6"
   
   
    t1 = Range(Range(MultiArea).Areas.Item(1), Range(MultiArea).Areas.Item(2))
   
    S = "Tableau de " & UBound(t1, 1) & " x " & UBound(t1, 2) & vbCrLf
   
    For i = 1 To UBound(t1, 1)
        For j = 1 To UBound(t1, 2)
            S = S & "<" & t1(i, j) & "> "
        Next j
        S = S & vbCrLf
    Next i
           
    MsgBox S
End Sub

 

[patricktoulon]

re

perso je veux jouer avec un tabl d'areas je joue avec l'areas tout court

Sub a()
    Dim MA
    Set MA = [A1:A3,C1:C6]
    MsgBox UBound(MA.Areas(1).Value)
    MsgBox UBound(MA.Areas(2).Value)
End Sub

le maître c'est MA qui est un range je peux donc travailler en lecture /ecriture en tant que tableau ou range