Microsoft 365 Tableaux emboités

Lolote83 · Aujourd'hui à 09:51

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

VB:

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 · Aujourd'hui à 14:46

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

VB:

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

sylvanu · Aujourd'hui à 10:31

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 : :

VB:

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 · Aujourd'hui à 11:05

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.

VB:

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 · Aujourd'hui à 11:07

bonjour le fil,
mon essai

VB:

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 · Aujourd'hui à 11:36

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 · Aujourd'hui à 14:04

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.

VB:

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 · Aujourd'hui à 14:25

Re,
Peut être avec ceci :

VB:

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 · Aujourd'hui à 14:46

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

VB:

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 · Aujourd'hui à 14:56

VB:

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 · Aujourd'hui à 16:00

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

Voici maintenant mon code simplifié

VB:

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 · Aujourd'hui à 21:13

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

VB:

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 · Aujourd'hui à 22:11

Lolote83 à dit:
- @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.

Microsoft 365 Tableaux emboités

Lolote83

XLDnaute Barbatruc

sylvanu

sylvanu

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

bsalv

XLDnaute Occasionnel

Pièces jointes

Lolote83

XLDnaute Barbatruc

Lolote83

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

bsalv

XLDnaute Occasionnel

Lolote83

XLDnaute Barbatruc

bsalv

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Discussions similaires

Microsoft 365 Tableaux emboités

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency