Tableau à 3 dimensions avec X classeurs à 1 onglet

**p.froide** · 03/12/2015, 15h27

Bonjour à tous,

Je suis confronté à un problème actuellement auquel je n'arrive pas à faire face. Toute aide sera la bienvenue.

J'ai actuellement X fichiers excel contenant chacun un onglet. Chaque fichier excel ne possède qu'un onglet, qui a un nombre variable de lignes, mais qui a toujours la même structure générale (9 colonnes fixes). Je recherche un moyen de rassembler toutes les données qui sont dans tous les fichiers à un seul endroit (afin de procéder à un post-traitement plus tard, mais ce n'est pas encore le sujet ici).

Mon idée était (et est encore) de créer un tableau à 3 dimensions qui pourrait contenir toutes ces données, mais je n'ai pas de pistes concernant la syntaxe qu'il faut utiliser. La première dimension contiendrait un id unique (1, 2, 3 etc... jusqu'à X), la deuxième dimension les colonnes et la troisième les lignes.

Cela a pour but d'accélérer le temps d’exécution de l'ensemble de ma macro. Actuellement ce que je fais, c'est de tout recopier dans fichier excel puis de faire mon post-traitement. Néanmoins, cela prends trop de temps lors de l’exécution.

Si quelqu'un a des idées, je suis preneur.

D'avance merci.

**Theze** · 03/12/2015, 17h34

Bonjour,

En fait, je pense que tu veux dire un tableau à 2 dimensions dont la première colonne (si on peut dire) contiendrait les Index.
Pour s'imaginer ce qu'est un tableau à 3 dimensions, il y a le Rumicube ou encore les feuilles de calcul Excel où par exemple la 1ère dimension serait les lignes, la seconde les colonnes et la troisième le nombre de feuilles et ça pourrait donner ceci :

Code :

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

1
2
3
4
5
6
7
8
9
 
ReDim Tbl(1 To Lignes, 1 To Colonnes, 1 To Feuilles)
où :
Tbl(1, 1, 1) = Cellule A1 de la 1ère feuille
Tbl(1, 1, 2) = Cellule A1 de la 2ème feuille
Tbl(2, 1, 1) = Cellule A2 de la 1ère feuille
Tbl(1, 2, 2) = Cellule B2 de la 2ème feuille
Tbl(1, 2, 3) = Cellule B2 de la 3ème feuille
etc...

Pas facile à gérer !
Pour toi, ça devrait plutôt ressembler à ça (une colonne est rajoutée par rapport à la plage A1:I40 pour inscrire les index ici, de 1 à 40) :

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
 
Sub Test()
 
    Dim Tbl()
    Dim Index As Long
    Dim X As Long
    Dim Y As Long
    Dim I As Long
    Dim J As Long
 
    X = 9 'colonnes (colonne A à I)
    Y = 40 'lignes (ligne 1 à 40)
 
    'redimensionne le tableau en ajoutant une colonne en plus pour les index
    ReDim Tbl(1 To X + 1, 1 To Y)
 
    For I = 1 To Y 'par ligne
 
        Index = Index + 1
        Tbl(1, I) = Index 'la première colonne sert aux index
 
        For J = 2 To X + 1 'par colonne
 
            'commence à A1, B1, C1...
                       'A2, B2, C2...
                       'A3, B3, C3...
                       'etc...
            Tbl(J, I) = Cells(I, J - 1).Value
 
    Next J, I
 
    'pour le test, inscrit les valeurs à partir de K1 (colonne K, les index)
    For I = 1 To UBound(Tbl, 2)
 
        For J = 1 To UBound(Tbl, 1)
 
            Cells(I, J + 10).Value = Tbl(J, I)
 
    Next J, I
 
    'ou directement en transposant...
    Range(Cells(1, 11), Cells(UBound(Tbl, 2), UBound(Tbl, 1) + 10)) = Application.WorksheetFunction.Transpose(Tbl())
 
End Sub

Pour tester déjà dans un premier temps pour 1 seul classeur, tu entre des valeurs de A1 à I40 puis tu lance la procédure Test en choisissant la façon que te veux pour retranscrire les valeurs dans la feuille à partir de K1 soit avec les boucles soit avec la fonction Transpose. Tu peux tester les deux en mettant une des deux en commentaire.

Invité · 03/12/2015, 17h43

Bonjour,
regardes ça: http://www.developpez.net/forums/d15...l/#post8370463

**kiki29** · 04/12/2015, 04h56

Salut, à lire : tableau en VBA et Application à l'optimisation du code sous Excel

**p.froide** · 04/12/2015, 08h04

Bonjour à tous,

Un grand merci pour vos réponses.

N'ayant pas trop l'habitude, j'avoue que je m'y perds un peu. Je vais essayer d'exprimer un peu mieux mon besoin :

Postulat de départ :
J'ai 50 fichiers excel avec un seul onglet. Chacun d'eux ont 9 colonnes et 1000 lignes (je simplifie).

Ce que je souhaiterais pouvoir faire est la chose suivante :
Récupérer à un seul endroit, et avec la manière la plus rapide possible, toutes ces données-la. Par la suite, je devrais faire des opérations (suppression/ajout de ligne, fusion d'autres) mais je verrai ça plus tard. Mon idée de base était de faire quelque chose qui ressemble à ça :

Code :

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

1
2
3
4
5
Tab(1,x,y) = workbook(1).worksheet(1).Range("A1:I1000")
Tab(2,x,y) = workbook(2).worksheet(1).Range("A1:I1000")
Tab(3,x,y) = workbook(3).worksheet(1).Range("A1:I1000")
...
Tab(50,x,y) = workbook(50).worksheet(1).Range("A1:I1000")

Est-ce possible ? J'ai remarqué que l’exécution sur un tableau à 2 dimensions était extrêmement rapide, mais je n'arrive pas à appliquer cette démarche à un tableau 3D (du coup, je pense que je ne peux pas me passer des 3 dimensions pour mon tableau).

Merci pour votre aide

Invité · 04/12/2015, 08h09

Bonjour,
C'est exactement ce que je te propose dans mon lien et il n'y a pas plus rapide q'ado!

**p.froide** · 04/12/2015, 10h07

Merci. Dans ce cas, je vais étudier cette solution plus précisément.

Re,

Je suis confronté à une erreur à la ligne suivante :

Code :

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

Rs.Open Cible, Cn

Nom : erere.png
Affichages : 2415
Taille : 3,8 Ko

Et je ne vois pas comment la résoudre.

Edit Suite :

En ouvrant le fichier en question, je remarque que le format n'est pas "texte" comme il doit l'être pour que cela fonctionne.

Du coup, je le force à "texte" mais si je sauvegarde, il repasse à "standard", ce qui me pose problème.

En ne sortant pas du fichier, il reste à "texte", et j'ai du coup une autre erreur :

Nom : gggg.png
Affichages : 2363
Taille : 6,0 Ko

Nom : gggg.png
Affichages : 2363
Taille : 6,0 Ko

Invité · 04/12/2015, 10h43

Bonjour,

en ouvrant le fichier en question, je remarque que le format n'est pas "texte" comme il doit l'être pour que cela fonctionne.

si tu fais une connexion du type Excel comme ça devrait être, tu rallonge le temps de traitement, car tu te connecte et déconnecte sur chaque fichier. mois je fait une connexion du type texte et j'indique dans ma requête un liaison externe; test comme ça

Code :

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

 Cible = "SELECT * FROM [" & Feuille & "] in '" & Dossier & "\" & Fichier & "' 'excel 12.0;HDR=YES""' ;"

ainsi je garde une connexion coté vba et la connexion externe ce fait par le driver que lui est de l'assembleur beaucoup plus rapide!

ici j'indique au driver la connexion externe 'excel 12.0;HDR=YES""' ;"

**p.froide** · 04/12/2015, 12h11

Re,

J'ai maintenant une nouvelle erreur de lecture seule ?

De ce que je comprends, logiquement, je ne suis pas en train d'écrire dans un fichier ? Je ne comprends pas trop d'où peut provenir ce message du coup.

Merci pour ton aide en tout cas.

Invité · 04/12/2015, 12h17

en réalité la base de données c'est un dossier sur ton disque dur! Dossier = "C:\Documents and Settings\plancher\Bureau\test_quinc\" & emplacement & "\"montre le code que tu as réalisé à partir de ce que je t'es donné.

**p.froide** · 04/12/2015, 12h37

J'ai essayé de l'adapter comme suit :

(pour le moment, je ne me concentre que sur la récupération d'un seul fichier, dont j'ai mis le nom en dur dans le code ci-dessous.

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
Sub compiler()
 
    'Nécessite d'activer la référence
    'Microsoft ActiveX Data Objects x.x Library
    Dim Cn As Object 'ADODB.Connection
    Dim Rst As Object ' ADODB.Recordset
    Dim xConnect As String, Cible As String
    Dim Fichier As String, Dossier As String, Feuille As String
    Dim i As Long
    Dim emplacement As String
 
    Dim Doc_source As Worksheet
    Dim Dossier_Model_Conductor As String
    Dim Dossier_Washer As String
    Dim Dossier_Wiper As String
    Dim Dossier_Sortie As String
    Dim Dossier_RiseUp As String
    Dim Dossier_Erreur As String
    Dim Dossier_Parent As String
 
    Dim nb_ModelConductor As Integer
    Dim nb_Washer As Integer
    Dim nb_Wiper As Integer
    Dim nb_cas_test As Integer
    Dim nb_RiseUp As Integer
    Dim nb_Erreur As Integer
 
    Set Doc_source = ThisWorkbook.Worksheets("Options")
 
    'Récupération des dossiers utilisés
    Dossier_Parent = Doc_source.Cells(2, 2)
    Dossier_Model_Conductor = Dossier_Parent & Doc_source.Cells(3, 2)
    Dossier_Washer = Dossier_Parent & Doc_source.Cells(4, 2)
    Dossier_Wiper = Dossier_Parent & Doc_source.Cells(5, 2)
    Dossier_Sortie = Dossier_Parent & Doc_source.Cells(6, 2)
    Dossier_RiseUp = Dossier_Parent & Doc_source.Cells(7, 2)
    Dossier_Erreur = Dossier_Parent & Doc_source.Cells(8, 2)
 
    'la série à traiter. <<============ Ajouter par mes soins
    'emplacement = InputBox("Quelle série dois-je traiter ?" & Chr(10) & Chr(10) & "Indiquer la série : ", "Série en cours de traitement", "01")
 
    'petit test pour éviter les soucis d'incohérence.
    'If Len(emplacement) <> 2 Then
    '    MsgBox "Vous avez fait une erreur ! La série doit être renseignée avec 2 caractères ! (Exemple pour la semaine 4 saisir : 04)"
    '    emplacement = InputBox("Quelle série dois-je traiter ?" & Chr(10) & Chr(10) & "Indiquer la série : ", "Série en cours de traitement", "01")
    '    If Len(emplacement) <> 2 Then
    '        MsgBox "Série incorrect à nouveau, veuillez relancer la commande svp..."
    '        Exit Sub
    '    End If
    'End If
 
    'nom du répertoire contenant les classeurs à regrouper
    'Dossier = "C:\Documents and Settings\plancher\Bureau\test_quinc\" & emplacement & "\"
 
    Dossier = Dossier_Model_Conductor
 
    'Nom de la feuille dans les classeurs fermés
    'Ne pas oublier le symbole $ après le nom de la feuille
    Feuille = "Feuil1$"
    'Test_Case_Test Case1_20151202_1
 
    i = 2
 
    'permet de ne pas cumuler plusieurs fois les mêmes nomenclatures
    'Range("A2:L100").Delete
    'Fichier = Dir(Dossier & "\*.csv")
 
    Fichier = Dossier & "\Test_Case_Test Case1_20151202_115716888_MConductor.csv"
 
    'boucle sur les fichiers du repertoire
    'connection Dossier
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Dossier & ";Extended Properties = text"
 
    Do While Len(Fichier) > 0
        'Requete
        Cible = "SELECT * FROM [" & Feuille & "] in '" & Dossier & "\" & Fichier & "' 'excel 12.0;HDR=YES;""' ;"
 
        Set Rs = CreateObject("ADODB.Recordset")
        Rs.Open Cible, Cn
        For c = 0 To Rs.Fields.Count - 1
            Range("A1").Offset(0, c) = Rs(c).Name
        Next
 
        'Ecriture dans la feuille de calcul
        Cells(i, 1).CopyFromRecordset Rs
        i = Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
        Rs.Close
        Set Rs = Nothing
        Fichier = Dir()
    Loop
 
    Cn.Close
 
    Set Cn = Nothing
 
    MsgBox "Réception des fichiers excel terminée."
End Sub

Invité · 04/12/2015, 12h49

te rend tu compte qu'il a fallu attendre le poste #12 pour que tu parle de CSV!

donc tu as un csv modèle dans lequel tu veux enserrer les valeur de 50 fichier CSV? c'est bien ça?

**p.froide** · 04/12/2015, 12h58

Hehe, je vous avais bien dis que je ne maîtrisais pas le sujet

Désolé :/

J'ai bien 50 fichiers csv, et je veux bien récupérer toutes les données mais à "l'intérieur de la macro VBA" car je vais ensuite faire tout un tas de choses avec ces données.

Et seulement ensuite, j'exporterai les résultats dans 50 nouveaux fichiers csv différents.

Je me rends compte en écrivant que je ne suis pas forcément très clair. N'hésitez pas à me demander plus de précisions.

Invité · 04/12/2015, 13h06

il y a une différence entre pas savoir si on aime le chocolat et savoir ce qu'est une tablette de chocolat !

**p.froide** · 04/12/2015, 14h20

Certes

Mais ceci dit, j'ai toujours mon problème.

J'ai cherché un peu du coté de la ligne "Provider=Microsoft.ACE.OLEDB.12.0;Data Source" en essayant de comprendre son fonctionnement, sans succès.

**Theze** · 04/12/2015, 16h02

Bonjour,

Une autre piste (toujours avec ADO) mais en fermant la connexion à chaque fois (désolé Robert ;-) ). Toutes fois, suite à mes différents tests, j'ai remarqué que le nom des fichiers doit être sans espaces, pourquoi ? Je ne sais pas ! Donc, si des fichiers ont des espaces, les remplacer par un tiret bas par exemple.
Il en est de même pour les valeurs ayant une virgule (pour les décimales), elles ne sont tout simplement pas rapatriées de même que les valeurs qui les suivent dans le même enregistrement. Il faut remplacer les virgules par des points.
Plutôt que d'utiliser un tableau en 3D, les valeurs récupérées dans les différents fichiers sont dispatchées dans différentes feuilles (si le nombre n'est pas suffisant, des feuilles seront rajoutées à fur et à mesure) :

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 
Sub RecupValeurs()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim TblFichiers() As String
    Dim Tableau
    Dim TblSplit
    Dim Chemin As String
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
 
    'ADAPTER le chemin du dossier...
    Chemin = "E:\"
 
    'appel de la fonction pour récupérer les noms des fichiers .csv
    TblFichiers = EnumFichiers(Chemin, ".csv")
 
    'si initialisé (au moins 1 classeur)
    If Not (Not TblFichiers) Then
 
        'boucle sur le tableau
        For L = 1 To UBound(TblFichiers)
 
            'se connecte au classeur
            ConnectCLasseur ConnectCL, Chemin, Rs, False
 
            With Rs
 
                'récupère les valeurs...
                .CursorType = 1
                .LockType = 3
                .Open "SELECT * FROM " & TblFichiers(L), ConnectCL
 
                .MoveFirst
 
                'redimensionne le tableau aux nombre d'enregistrements et aux nombre de champs, adapter le séparateur (ici, le point virgule)
                ReDim Tableau(1 To .RecordCount, 1 To UBound(Split(.Fields(0).Value, ";")) + 1)
 
                Do While Not .EOF
 
                    'splite l'enregistrement, adapter le séparateur (ici, le point virgule)
                    TblSplit = Split(.Fields(0).Value, ";")
 
                    I = I + 1
 
                    'tranfère chaque valeur dans le tableau
                    For K = 0 To UBound(TblSplit): J = J + 1: Tableau(I, J) = TblSplit(K): Next K
 
                    J = 0
 
                    .MoveNext
 
                Loop
 
                I = 0
 
            End With
 
            With ThisWorkbook
 
                'si pas assez de feuilles, ajoute à fur et à mesure
                If .Worksheets.Count < L Then .Worksheets.Add , .Worksheets(.Worksheets.Count)
 
                'colle les valeurs dans la feuille en cours à partir de A1
                With .Worksheets(L)
 
                    .Range(.Cells(1, 1), .Cells(UBound(Tableau, 1) - 1 + DerCel, UBound(Tableau, 2))).Value = Tableau
 
                End With
 
            End With
 
            'ferme la connexion
            ConnectCL.Close
 
       Next L
 
    End If
 
End Sub
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Fichier As String, _
                            Optional Rs, _
                            Optional Entetes As Boolean = False)
 
    Dim HDR As String
 
    Set ConnectCL = CreateObject("ADODB.Connection")
 
    If Not IsMissing(Rs) Then Set Rs = CreateObject("ADODB.Recordset")
 
    If Entetes = False Then HDR = "NO" Else HDR = "YES"
 
    ConnectCL.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & Fichier & ";" & _
                    "Extended Properties=""text; HDR=" & HDR & "; FMT=Delimited; IMEX=1;""")
 
End Sub
 
Function EnumFichiers(Chemin As String, Extension As String) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    'complète le chemin le cas échéant
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
 
    'récupère seulement les fichiers Excel
    Fichier = Dir(Chemin & "*" & Extension & "*")
 
    'boucle sur les fichiers du dossier
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Fichier
 
        Fichier = Dir()
 
    Loop
 
    'retourne le tableau des noms de fichiers
    EnumFichiers = TableauFichiers()
 
End Function

Invité · 04/12/2015, 17h12

Tu gagneras du temp en faisant un copyrecordset dans Excel et ensuite un MyTableau= seets(?).UsedRange.value

**p.froide** · 04/12/2015, 20h12

Bonsoir à tous,

Alors, je m'en suis sorti grâce au premier message de Theze. J'ai investigué dans le sens de son message, et j'ai découvert comment créer un variant de variant, ce qui a parfaitement répondu à mon besoin.

Donc je récupère les informations comme suit (un exemple parmi ceux que j'ai créé).

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
'Déclaration
          Dim tab_wiper() As Variant
          ReDim tab_wiper(nb_Wiper + 1) As Variant
          For i = 1 To nb_Wiper
 
        'Sélection d'un cas de test wiper brut
        fichierWi = TrouveFichier(Dossier_Wiper, i)
 
        'ouverture du fichier
        Set sourceWi = appExcel.Workbooks.Open(fichierWi, local:=True)
 
        derniere_ligne = sourceWi.Worksheets(1).Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
        tab_wiper(i) = sourceWi.Worksheets(1).Range("A1:I" & derniere_ligne)
 
        'fermeture du fichier
        sourceWi.Close savechanges:=False
 
    Next i

Du coup je peux accéder aux valeurs de mon tab_wiper(x)(y,z) très facilement avec

x=indice du tableau
y=contenu des lignes
z=contenu des colonnes

Je suis, grâce à ça, passé d'un temps d’exécution de 3h à 2min, ce qui est parfait

Merci à tous d'avoir contribuer à mon travail.

Tableau à 3 dimensions avec X classeurs à 1 onglet [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager