Microsoft 365 Tableaux emboités

[Lolote83]

Bonjour à tous,
J'ai des tableaux "array" défini et je voudrais les emboiter.
J'y arrive facilement comme le montre le code ci-dessous mais j'aurais aimé le faire via une boucle car il se peut que j'ai jusqu'à 10 array.

L'exemple donné est simplifié à 3 array

Sub TableauEmboités()
    Dim Tablo1(1 To 3)                      'Pour écriture 1
    
    xTab1 = Array("a", "b", "c", "d")
    xTab2 = Array("e", "f", "g", "h")
    xTab3 = Array(1, 2, 3, 4)
    
    '------------------------------------- Ecriture 1
    Tablo1(1) = xTab1
    Tablo1(2) = xTab2
    Tablo1(3) = xTab3
    
    '------------------------------------- Ecriture 2
    Tablo2 = Array(xTab1, xTab2, xTab3)
    
    
    Dim Tablo3(1 To 3)                      'Pour écriture 3
    For F = 1 To 3
        Tablo3(F) = "xTab" & F
    Next F
End Sub

Quand j'exécute le code,
la partie Ecriture 1 donne la copie ci-dessous

La partie Ecriture 2 donne la copie ci-dessous

Pour la partie Ecriture 3, j'essaye de passer par une boucle mais cela ne donne pas le résultat souhaité (C'est normal car cela transforme en string mes données) mais je ne sais pas comment faire (voir copie ci-dessous)

Si toutefois quelqu'un trouve une solution, ce serait cool.

Cordialement
Lolote83

 

[sylvanu]

Bonjour Lolote,
Une façon de faire suggéré par Gemini. L'astuce est d'utiliser un array d'array où on met la liste de tous les arrays à concaténer : :

Sub FusionDynamique()
    Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
    Dim collectionDeTableaux As Variant
    Dim finalArr() As Variant
    Dim itemTableau As Variant ' Variable pour la boucle
    Dim element As Variant
    Dim k As Long, totalSize As Long
    ' Vos données
    arr1 = Array("Pomme", "Poire")
    arr2 = Array("Carotte", "Chou", "Navet")
    arr3 = Array("Lundi", "Mardi")
    ' --- L'ASTUCE : On met les objets Array dans un Array ---
    collectionDeTableaux = Array(arr1, arr2, arr3)
    ' 1. Calculer la taille totale dynamiquement
    For Each itemTableau In collectionDeTableaux
        totalSize = totalSize + (UBound(itemTableau) - LBound(itemTableau) + 1)
    Next itemTableau
    ' 2. Préparer le tableau final
    ReDim finalArr(1 To totalSize)
    k = 1
    ' 3. La boucle unique (imbriquée) pour tout fusionner
    For Each itemTableau In collectionDeTableaux
        For Each element In itemTableau
            finalArr(k) = element
            k = k + 1
        Next element
    Next itemTableau
    ' Vérification
    MsgBox "Fusion terminée ! Nombre d'éléments : " & UBound(finalArr)
End Sub

 

[mapomme]

Bonjour à tous,

Pour ce que j'en ai compris, voici une autre macro de ma pomme sans doute moins souple que celle de @sylvanu que je salue😉. On est limité à 10 tableaux de type xTab mais on peut l'augmenter aisément. ndim est le nombre d'élément de Tablo3 (de 1 à ndim). Si ndim est nul alors il n'y a aucun élément dans Tablo3.

Le code dans Module1.

Sub TableauEmboités()
   xTab1 = Array("a", "b", "c", "d")
   xTab2 = Array("e", "f", "g", "h")
   xTab3 = Array(1, 2, 3, 4)
 
   On Error Resume Next
   t = Array(xTab1, xTab2, xTab3, xTab4, xTab5, xTab6, xTab7, xTab8, xTab9, xTab10)
   ndim = 0
   For i = 0 To 9: ndim = ndim + IIf(IsNumeric(LBound(t(i))), 1, 0): Next
   On Error GoTo 0
   If ndim >= 1 Then
      ReDim Tablo3(1 To ndim)
      For i = 1 To ndim: Tablo3(i) = t(i - 1): Next
   End If
End Sub

 

[bsalv]

bonjour le fil,
mon essai

Public aOut
Sub M_Test()
     Dim Arr, Temp, i0, i1
     Arr = Array(Array("a", "b", "c", "d"), Array("e", "f", "g", "h"), Array(1, 2, 3, 4), WorksheetFunction.RandArray(5, 10),range("A1:C3").value2)     'array avec plusieurs arrays
     For i0 = 0 To UBound(Arr)               'boucler les arrays
          Temp = Arr(i0)
          If VarType(Temp) = vbArray + vbVariant Then     'vérifier si c'est un array
               On Error Resume Next
               i1 = "": i1 = UBound(Temp, 2)     'vérifier si l'array est une ou plusieurs dimensions
               On Error GoTo 0
               If Not IsNumeric(i1) Then     'une dimension
                    For i2 = LBound(Temp) To UBound(Temp)
                         M_Ajouter Temp(i2)
                    Next
               Else                          'plusieurs dimensions
                    For i2 = LBound(Temp) To UBound(Temp)
                         For i3 = LBound(Temp, 2) To UBound(Temp, 2)
                              M_Ajouter Temp(i2, i3)
                         Next
                    Next
               End If
          End If
     Next
     MsgBox Join(Application.Transpose(Application.Transpose(aOut)), vbLf)
End Sub

Sub M_Ajouter(it_)
     If VarType(aOut) <> vbArray + vbVariant Then
          ReDim aOut(0)
     Else
          ReDim Preserve aOut(1 To UBound(aOut) + 1)
     End If
     aOut(UBound(aOut)) = it_
End Sub

 

[Lolote83]

Bonjour à tous. Merci, je vais regarder vos propositions, essayé de les comprendre afin de mon coté d'apprendre d'avantage.
Je vous tiens au courant
Cordialement
Lolote83

 

[Lolote83]

Re bonjour à tous,
Après analyse de vos propositions :
- @sylvanu , ton code fonctionne mais cela ne répond pas vraiment à ma demande car j'aurais aimé plutôt que de tout avoir sous forme unique comme dans ton cas, avoir la forme par item. En fait, dans ton code, je voulais m'affranchir de la ligne collectionDeTableaux = Array(arr1, arr2, arr3) car si plus de tableau (array) il faut définir cette ligne.

- @mapomme, ton code donne le résultat escompté, mais selon la même remarque que pour Sylvannu, j'aurais aimé m'affranchir de la ligne t = Array(xTab1, xTab2, xTab3, xTab4, xTab5, xTab6, xTab7, xTab8, xTab9, xTab10) pour les mêmes raisons évoquées dans la réponse à Sylvannu

- @bsalv, Ton code ne donne pas vraiment le résultat escompté, et là aussi, j'aurais aimé m'affranchir de cette ligne
Arr = Array(Array("a", "b", "c", "d"), Array("e", "f", "g", "h"), Array(1, 2, 3, 4), WorksheetFunction.RandArray(5, 10), Range("A1:C3").Value2) 'array avec plusieurs arrays, encore une fois pour les mêmes raisons

Pour résumer, j'ai tout fourni dans un seul code au depart pour montrer les possibilités, mais au final, je pensais (si cela était possible) le résumer ainsi avec l'utilisation d'une boucle.

Sub TableauEmboités_V2()
    xTab1 = Array("a", "b", "c", "d")
    xTab2 = Array("e", "f", "g", "h")
    xTab3 = Array(1, 2, 3, 4)
   
    '---------------------------------------- Reconstruire ci-dessous un nouvel array avec les 3 array de départ sous forme de boucle
    Dim Tablo3(1 To 3)
    For F = 1 To 3
        Tablo3(F) = "xTab" & F              'Cette ligne ne fonctionn pas
    Next F
End Sub

Dans ce cas, je vais rester sur ma ligne : Tablo2 = Array(xTab1, xTab2, xTab3) et si j'ai d'autres tableaux à rajouter, je le ferais à la main.

Exemple avec 6 tableaux
Tablo2 = Array(xTab1, xTab2, xTab3, xTab4, xTab5, xTab6) etc etc etc

A priori, après quelques recherches, il semblerai que cela ne soit pas possible ou je n'ai pas su trouver.
Merci à tous pour vos recherches et vos participations.
Néammoins, j'aurais tout de même appris quelque chose

Cordialement
Lolote83

 

[sylvanu]

Re,
Peut être avec ceci :

Sub TableauEmboités2()
    xTab1 = Array("a", "b", "c", "d")
    xTab2 = Array("e", "f", "g", "h")
    xTab3 = Array(1, 2, 3, 4)
    Tablo1 = Array(xTab1, xTab2, xTab3)
    For N = 1 To UBound(Tablo1)
        Tablo1(N) = Tablo1(N)
    Next N
End Sub

Ce qui donne :

Mais il faut quand même faire la liste des arrays à concaténer.

 

[sylvanu]

Re,
Une autre approche, changer la syntaxe des arrays. Il faut juste définir le nombre d'arrays à concaténer.

Sub TableauEmboités3()
Dim xTab(1 To 3)
    xTab(1) = Array("a", "b", "c", "d")
    xTab(2) = Array("e", "f", "g", "h")
    xTab(3) = Array(1, 2, 3, 4)
End Sub

 

[bsalv]

Public aOut

Sub M_Test()
     Dim Arr, Temp, i0, i1, i2, i3, xTab1, xTab2, xTab3, xTab4, xTab5, xTab6, xTab7, xTab8, xTab9, xTab10

     xTab1 = Array("a", "b", "c", "d")       'on utilise pas tous les "xTabs", le reste est "variant/empty"
     xTab2 = Array("e", "f", "g", "h")
     xTab3 = Array(1, 2, 3, 4)
     xTab7 = Array(11, 22, 33, 44)
     Arr = Array(xTab1, xTab2, xTab3, xTab4, xTab5, xTab6, xTab7, xTab8, xTab9, xTab10, xTab11, xTab12, xTab13, xTab14, xTab15)     'tous les xTabs possibles, aussi ceux qui ne servent à rien

     aOut = ""
     For i0 = 0 To UBound(Arr)               'boucler les arrays
          Temp = Arr(i0)
          If VarType(Temp) = vbArray + vbVariant Then     'vérifier si c'est un array
               On Error Resume Next
               i1 = "": i1 = UBound(Temp, 2)     'vérifier si l'array est une ou plusieurs dimensions
               On Error GoTo 0
               If Not IsNumeric(i1) Then     'une dimension
                    For i2 = LBound(Temp) To UBound(Temp)
                         M_Ajouter Temp(i2)
                    Next
               Else                          'plusieurs dimensions
                    For i2 = LBound(Temp) To UBound(Temp)
                         For i3 = LBound(Temp, 2) To UBound(Temp, 2)
                              M_Ajouter Temp(i2, i3)
                         Next
                    Next
               End If
          End If
     Next
   
     If VarType(aOut) = vbArray + vbVariant Then
          MsgBox Join(aOut, vbLf)
     Else
          MsgBox "erreur"
     End If
End Sub

Sub M_Ajouter(it_)
     If VarType(aOut) <> vbArray + vbVariant Then
          ReDim aOut(0)
     Else
          ReDim Preserve aOut(0 To UBound(aOut) + 1)
     End If
     aOut(UBound(aOut)) = it_
End Sub

 

[Lolote83]

Re bonjour,
Finalement, j'opte pour la solution du post#8 de @sylvanu

Voici maintenant mon code simplifié

Sub TestArraySylvanu()
    Dim xTablo(1 To 12)
    xTablo(1) = Array(1, "Rouge", 255, 55, 86)
    xTablo(2) = Array(2, "Orange", 232, 130, 93)
    xTablo(3) = Array(3, "Pêche", 255, 205, 143)
    xTablo(4) = Array(4, "Jaune", 253, 238, 101)
    xTablo(5) = Array(5, "Vert clair", 82, 206, 144)
    xTablo(6) = Array(7, "Vert citron", 182, 215, 103)
    xTablo(7) = Array(8, "Bleu", 92, 169, 229)
    xTablo(8) = Array(9, "Lavande", 177, 170, 235)
    xTablo(9) = Array(11, "Gris clair", 197, 206, 209)
    xTablo(10) = Array(13, "Gris chaud", 195, 197, 187)
    xTablo(11) = Array(18, "Marron", 188, 143, 111)
    xTablo(12) = Array(24, "Violet foncé", 165, 137, 203)
End Sub

Il y aura au final qu'une seule valeur à changer si encore plus de tableaux (array) de défini sur la ligne Dim xTablo(1 To 12)

Avec ça, je vais me débrouiller pour la suite.
Merci à vous tous.
@+ Lolote83

 

[bsalv]

peut-être voulez-vous faire ceci ...

Sub TestArraySylvanu()
     Dim xTablo(1 To 12), aCouleurs
     xTablo(1) = Array(1, "Rouge", 255, 55, 86)
     xTablo(2) = Array(2, "Orange", 232, 130, 93)
     xTablo(3) = Array(3, "Pêche", 255, 205, 143)
     xTablo(4) = Array(4, "Jaune", 253, 238, 101)
     xTablo(5) = Array(5, "Vert clair", 82, 206, 144)
     xTablo(6) = Array(7, "Vert citron", 182, 215, 103)
     xTablo(7) = Array(8, "Bleu", 92, 169, 229)
     xTablo(8) = Array(9, "Lavande", 177, 170, 235)
     xTablo(9) = Array(11, "Gris clair", 197, 206, 209)
     xTablo(10) = Array(13, "Gris chaud", 195, 197, 187)
     xTablo(11) = Array(18, "Marron", 188, 143, 111)
     xTablo(12) = Array(24, "Violet foncé", 165, 137, 203)
     aCouleurs = Application.Transpose(Application.Index(xTablo, , 2))     'récuperer les couleurs

     r = Application.IfError(Application.Match("Gris Chaud", aCouleurs, 0), 0)     'quelle ligne correspond avec tel couleur ?
     If r = 0 Then
          MsgBox "erreur, aucun couleur ..."
     Else
          Range("A1").Interior.Color = RGB(xTablo(r)(2), xTablo(r)(3), xTablo(r)(4))
     End If
End Sub

 

[mapomme]

- @mapomme, ton code donne le résultat escompté, mais selon la même remarque que pour Sylvannu, j'aurais aimé m'affranchir de la ligne t = Array(xTab1, xTab2, xTab3, xTab4, xTab5, xTab6, xTab7, xTab8, xTab9, xTab10) pour les mêmes raisons évoquées dans la réponse à Sylvannu

Je tiens à signaler que le code fonctionne de 1 à 10 tableaux xTabi. C'est ce qui était demandé.
t est Juste un tableau intermédiaire. Le tableau final est Tablo3.