Concaténation de tableaux structurés par VBA
Bonjour les amis du Forum,
Je m'interrogeais sur le processus à suivre pour sommer 2 tableaux structurés.
Une méthode consisterait à utiliser les variables ... Tableau :)
Soit
Au préalable, acquérir le code qui aboutit à la sommation de 2 variables tableau
Affecter une première variable tableau au premier tableau structuré, puis une seconde variable au second tableau.
Sommer les 2 variables tableau
Reverser ce tableau dans le tableau structuré final (celui-ci ayant été vidé au préalable)
Ce qui donne
Pour la fonction de concaténation de 2 variables tableau
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
| Function ArrayPlusNew(ArrDep As Variant, Plus As Variant)
'ajoute l'array Plus à l'array ArrDep
'l'array d'arrivée est un nouvel Array
Dim ArrFinal
Dim i As Integer, j As Integer, k As Integer
k = 1
ReDim ArrFinal(1 To UBound(ArrDep, 1), 1 To UBound(ArrDep, 2) + UBound(Plus, 2))
For i = 1 To UBound(ArrDep, 1)
For j = 1 To UBound(ArrDep, 2)
ArrFinal(i, j) = ArrDep(i, j)
Next j
For j = UBound(ArrDep, 2) + 1 To UBound(ArrFinal, 2)
ArrFinal(i, j) = Plus(i, k)
k = k + 1
Next j
k = 1
Next i
ArrayPlusNew = ArrFinal
End Function |
Pour la procédure
Code:
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
| Option Explicit
Sub ConcatTabloStruc()
Dim Tblo1() As Variant, Tblo2() As Variant, TbloTot() As Variant
Dim Tblo As Variant, tb As Variant
'Vider le tableau de concaténation initial
Worksheets("Feuil3").Range("ConcatTablo").ListObject.DataBodyRange.Delete
'Pour sommer 2 Arrays, il est nécessaire que la 1ère dimension soit identique
'D'où le nombre de colonnes en 1ère dimension
With WorksheetFunction
Tblo1 = .Transpose(Worksheets("Feuil1").Range("FirstTablo").Value)
Tblo2 = .Transpose(Worksheets("Feuil2").Range("ScndTablo").Value)
'Cellules vides de départ
TbloTot = .Transpose(Worksheets("Feuil3").Range("A50000:B50000").Value)
End With
'Constitution d'un tableau de tableaux pour effectuer la boucle
'et sommer un à un les tableaux à partir du 2ème sur le 1er
Tblo = Array(Tblo1, Tblo2)
For Each tb In Tblo
TbloTot = ArrayPlusNew(tb, TbloTot)
Next
'Suppression de la dernière ligne vide initialement TbloTot
ReDim Preserve TbloTot(1 To 2, 1 To UBound(TbloTot, 2) - 1)
Worksheets("Feuil3").Range("A2").Resize(UBound(TbloTot, 2), UBound(TbloTot, 1)).Value = WorksheetFunction.Transpose(TbloTot)
'Variables Tableau vidées
Erase Tblo1
Erase Tblo2
Erase TbloTot
MsgBox _
Prompt:="La nouvelle concaténation contient" & Chr(13) & _
Worksheets("Feuil3").Range("ConcatTablo").ListObject.DataBodyRange.Rows.Count & " enregistrements.", _
Buttons:=vbInformation, _
Title:="Résultat"
End Sub |
Code testé.
(En fait, il s'agit, pour mon développement, de 3 fichiers différents ayant la même structure. Et je suis viscéralement opposé aux classeurs partagés.)
A noter.
Le processus est adaptable à 3, 4, 5, et plus tableaux structurés.
Je voulais vous faire part de cette proposition en attendant, bien entendu, vos judicieuses remarques.
Il pourrait y avoir en effet d'autres processus envisageables.
A vous lire donc.
Bon après-midi à tous.
