Discussion :

[ericdev67]

Bonjour,

Je pense que cela doit vraiment être simple, mais...je ne trouve pas....

j'ai 1 classeur, 2 feuilles. Dans chaque feuille des données que je souhaite exploiter (beaucoup de colonnes...). Pour la lecture de la première ligne, j'ai :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
ncol = 9911 'colonne NQE
Set P1 = Sheets("Base1").UsedRange.Resize(, ncol)
rc = P1.Rows.Count
'---ligne de titres---
titre1 = P1.Rows(1) 
'pour la 2ème feuille 
ncol = 9796 'colonne NLT
Set P2 = Sheets("Base2").UsedRange.Resize(, ncol)
rc = P2.Rows.Count
'---ligne de titres---
titre2 = P2.Rows(1) 2

Je cherche à créer un tableau "Titre" qui mettrait à la suite Titre1 et Titre2 pour que l'ensemble des données de la 1ère ligne (soit les 19683 colonnes (9899-12 + 9784-12 (car je commence les données à partir de la colonne 12)) soient compilées en 1 seul tableau....

Merci pour votre aide,

[EricDgn]

Bonjour,

Je ne saisis pas vraiment ce que vous essayer de faire, mais s'il s'agit de placer dans une 3e feuille la ligne des titres des feuille 1 et 2, ceci devrait le faire:

Code :

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

1
2
3
4
5
6
7
    With Worksheets("Feuil1")
        .Range(.Cells(1, 13), .Cells(1, 9899)).Copy Worksheets("Feuil3").Cells(1, 1)
    End With
    With Worksheets("Feuil2")
        .Range(.Cells(1, 13), .Cells(1, 9784)).Copy Worksheets("Feuil3").Cells(1, 9899 - 12 + 1)
    End With
    Application.CutCopyMode = False

Seul problème: une feuille Excel n'accepte que 16384 colonnes ... et vous souhaitez en placer plus de 19000 !

Cordialement.

[ericdev67]

Bonjour EricDgn,

Oui, pour le nombre de colonne par feuille, je sais, c'est d'ailleurs pour cela que j'ai "répartit" mes données sur 2 feuilles : j'ai "besoin" de 19500 colonnes et 50000 lignes...donc j'ai répartit mes données en 2 feuilles, et là je souhaite pouvoir les ré-utiliser et donc c'est pour cela que j'essaye de "compiler" les colonnes des 2 feuilles....

Merci pour votre aide,
Eric

[EricDgn]

Bonjour,

Théoriquement on peut faire cela avec PowerQuery, mais en pratique cela ne marche pas, en tout cas pas sur mon pc. Un exemple avec les 19600 colonnes et seulement 100 lignes de données. Non testé avec des entiers seulement: Grand tableau.xlsx. Cliquer sur Données / Requêtes et connexions pour afficher la liste des requêtes, dont FusionAB.

Cordialement.

[MarcelG]

Bonjour à vous, Bonjour au Forum,

Il est possible de sommer 2 variables tableau possédant une dimension commune.
Cette somme est un nouveau tableau.

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
Function SumTablo(TbloFirst As Variant, TbloScnd As Variant) As Variant
 
'Ajoute le tableau TbloScnd au tableau TbloFirst
'SumTablo est un nouveau tableau, compilation des 2 premiers
 
Dim i As Integer, j As Integer, k As Integer
 
k = 1
ReDim TbloFinal(1 To UBound(TbloFirst, 1), 1 To UBound(TbloFirst, 2) + UBound(TbloScnd, 2))
For i = 1 To UBound(TbloFirst, 1)
        For j = 1 To UBound(TbloFirst, 2)
                TbloFinal(i, j) = TbloFirst(i, j)
        Next j
        For j = UBound(TbloFirst, 2) + 1 To UBound(TbloFinal, 2)
                TbloFinal(i, j) = TbloScnd(i, k)
                k = k + 1
        Next j
        k = 1
Next i
 
SumTablo = TbloFinal
 
End Function

Partant, si l'on affecte une variable tableau au corps de cellule (plage de données) de chaque tableau structuré,
Nous pouvons réinjecter cette variable tableau "somme" dans le tableau structuré de concaténation.

Soit:

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
Option Explicit
 
Sub ConcatTabloStruc()
 
Dim dest As Range
 
'Vider le tableau de concaténation initial
With Worksheets("lawks_Tot").ListObjects("TbloStruc_Tot")
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set dest = .ListRows.Add.Range.Cells(1, 1)
End With
 
ReDim Tblo1(0 To 0, 0 To 0) As Variant
ReDim Tblo2(0 To 0, 0 To 0) As Variant
 
'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 Application.WorksheetFunction
        Tblo1 = .Transpose(Worksheets("lawks_1").Range("TbloStruc_1").Value)
        Tblo2 = .Transpose(Worksheets("lawks_2").Range("TbloStruc_2").Value)
End With
 
ReDim TbloTot(0 To 0, 0 To 0) As Variant
 
TbloTot = SumTablo(Tblo1, Tblo2)
 
dest.Resize(UBound(TbloTot, 2), UBound(TbloTot, 1)).Value = WorksheetFunction.Transpose(TbloTot)
 
Erase TbloTot
Erase Tblo2
Erase Tblo1
 
Set dest = Nothing
 
End Sub

Plusieurs remarques:

1 - Comme pour une variable numérique, il est possible d'utiliser la fonction SumTablo en boucle

Code :

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

n = n+1

devient alors

Code :

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

TbloTot = SumTablo(TB, TbloTot)

2 - Pour mieux illustrer l'exposé, j'ai choisi de ne pas utiliser les CodeName des feuilles de travail.

[EricDgn]

Bonjour,

Ce que propose MarcelG ajoute la table2 "en dessous" de la table1 et en place le résultat dans une autre feuille. Mais l'idée est excellente, et en voici une adaptation pour construire une table (array) où les table1 et table2 sont mises côte à côte (merge) sans reprise de la colonne n°1 de table2, supposée identique à la colonne n°1 de table1. Le résultat est TbloFinal conservé en mémoire, ayant un trop grand nombre de colonnes pour être mis sur une feuille.

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
69
Option Explicit
 
'--- adapté de
'--- https://www.developpez.net/forums/d2122409/logiciels/microsoft-office/excel/macros-vba-excel/compilation-2-tableaux-appartenant-2-feuilles-differentes/#post11789717
 
Dim TbloFinal As Variant
 
Private Sub AddTablo(TbloFirst As Variant, TbloScnd As Variant)
    '--- Ajoute le tableau TbloScnd en dessous du tableau TbloFirst => TabloFinal
    '--- Il est nécessaire que les 2 tableaux aient le même nombre de lignes
    If UBound(TbloFirst, 1) <> UBound(TbloScnd, 1) Then
        MsgBox "Abandonné: les 2 plages n'ont pas le même nombre de colonnes !", , "Non admis"
        TbloFinal = Nothing
        Exit Sub
    End If
    '---
    Dim i As Integer, j As Integer, k As Integer
    k = 1
    ReDim TbloFinal(1 To UBound(TbloFirst, 1), 1 To UBound(TbloFirst, 2) + UBound(TbloScnd, 2))
    For i = 1 To UBound(TbloFirst, 1)
            For j = 1 To UBound(TbloFirst, 2)
                    TbloFinal(i, j) = TbloFirst(i, j)
            Next j
            For j = UBound(TbloFirst, 2) + 1 To UBound(TbloFinal, 2)
                    TbloFinal(i, j) = TbloScnd(i, k)
                    k = k + 1
            Next j
            k = 1
    Next i
End Sub
 
Private Sub MergeTablo(TbloFirst As Variant, TbloScnd As Variant)
    '--- Ajoute le tableau TbloScnd à côté du tableau TbloFirst => TbloFinal
    '--- Il est nécessaire que les 2 tableaux aient le même nombre de colonnes
    If UBound(TbloFirst, 2) <> UBound(TbloScnd, 2) Then
        MsgBox "Abandonné: les 2 plages n'ont pas le ême nombre de lignes !", , "Non admis"
        TbloFinal = Nothing
        Exit Sub
    End If
    '---
    Dim i As Integer, j As Integer, k As Integer
    ReDim TbloFinal(1 To UBound(TbloFirst, 1) + UBound(TbloScnd, 1) - 1, 1 To UBound(TbloFirst, 2))
    Debug.Print UBound(TbloFinal, 1), UBound(TbloFinal, 2)
    For i = 1 To UBound(TbloFirst, 1)
        For j = 1 To UBound(TbloFirst, 2)
            TbloFinal(i, j) = TbloFirst(i, j)
        Next j
    Next i
    k = UBound(TbloFirst, 1) - 1
    For i = 2 To UBound(TbloScnd, 1)
        For j = 1 To UBound(TbloScnd, 2)
            TbloFinal(k + i, j) = TbloScnd(i, j)
        Next j
    Next i
End Sub
 
Sub ConcatTabloStruc()
    ReDim Tblo1(0 To 0, 0 To 0) As Variant
    ReDim Tblo2(0 To 0, 0 To 0) As Variant
    With Application.WorksheetFunction
            Tblo1 = .Transpose(Worksheets("Feuil1").Range("rA").Value)
            Tblo2 = .Transpose(Worksheets("Feuil2").Range("rB").Value)
    End With
    Debug.Print UBound(Tblo1, 1), UBound(Tblo1, 2), UBound(Tblo2, 1), UBound(Tblo2, 2)
'    AddTablo Tblo1, Tblo2
    MergeTablo Tblo1, Tblo2
    Erase Tblo2
    Erase Tblo1
End Sub

Cordialement.