Discussion :

[pat91]

Bonjour,

Je vous sollicite pour voir s'il y a moyen d'optimiser le code ci-dessous car le traitement est soit très long (plusieurs minutes) soit plante Excel par saturation de UC (processus sans réponse d’Excel) !

Ce code est l'assemblage de bouts de code généreusement proposé par des contributeurs de ce forum, qui se reconnaitrons et que je remercie encore

J'en ai fait une synthèse et essayé de le simplifier, mais là je pense avoir atteint mes limites.
Pouvez-vous y jeter un coup d’œil pour voir s’il y a possibilité de réduire la charge de l’UC.
Le fichier joint comporte ~380 fichiers de données, mais normalement je récupère 800 fichiers.

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
 
Option Explicit
 
Sub Empilement()
    Dim F1 As Worksheet, F2 As Worksheet
    Dim i As Long, DerCol_f1 As Long, DerCol As Long, DerLig_f1 As Long, DerLig_f2 As Long, DerCol_f2 As Long, DerLig_Mes As Long, Lig_f2 As Long, Col_f2 As Long, c As Long, Nb_Lig As Long, k As Long, L As Long
    Dim m As Range, cell As Range
    Dim d As Object
    Application.ScreenUpdating = False
    Set F1 = Sheets("BDD")
    Set F2 = Sheets("Synthese")
    F2.Cells.Clear
 
 
    'Concatenation et positionnement du terme mesure x
 
    DerLig_f1 = F1.Cells(Rows.Count, 1).End(xlUp).Row
        'Application.ScreenUpdating = False
            For i = 1 To DerLig_f1
                If F1.Cells(i, "A") Like "Mesure:" Then
                    F1.Cells(i + 16, "A") = F1.Cells(i, "A") & F1.Cells(i, "B")
                End If
            Next i
 
 
    'sélection et transposition des données de colonnes Feuille 1 à lignes Feuille 2
 
    Set d = CreateObject("Scripting.Dictionary")
    DerLig_f1 = F1.Range("A" & Rows.Count).End(xlUp).Row
    Col_f2 = 2
    For i = 1 To DerLig_f1
        Lig_f2 = 13
         With F1.Range("A1:A" & DerLig_f1)
            Set m = .Find("Mesure:" & i, lookat:=xlWhole)
 
            'identification de la plage de données et enregistrement du NB de colonne
            If Not m Is Nothing Then
                DerCol_f1 = F1.Cells(m.Row + 1, 16384).End(xlToLeft).Column
                DerLig_Mes = F1.Cells(m.Row + 1, "B").End(xlDown).Row
                For c = DerCol_f1 To 1 Step -1
                    For Each cell In Range(F1.Cells(m.Row + 1, c), F1.Cells(DerLig_Mes, c))
                        d.Add cell, ""
                    Next cell
                    F2.Cells(Lig_f2, Col_f2).Resize(d.Count, 1) = Application.Transpose(d.keys)
                     Lig_f2 = Lig_f2 + d.Count
                    d.RemoveAll
                Next c
                F2.Cells(1, Col_f2) = i
                Col_f2 = Col_f2 + 1
            End If
        End With
    Next i
 
    'remplissage de la première colonne avec la position des données par ligne
    With F1.Range("A1:A" & DerLig_f1)
        Set m = .Find("mesure:1", lookat:=xlWhole)
        DerLig_Mes = F1.Cells(m.Row, "B").End(xlDown).Row
        DerCol_f2 = F2.Cells(2, 2).End(xlToRight).Column
        DerLig_f2 = F2.Columns("B").Find(what:="*", searchdirection:=xlPrevious).Row
 
    End With
 
    'récupération des heures de relevées des données
    F2.Cells(2, 1) = "Heure :"
    L = 2
    DerLig_f1 = F1.Cells(Rows.Count, 1).End(xlUp).Row
        'Application.ScreenUpdating = False
            For i = 1 To DerLig_f1
                If F1.Cells(i, "A") Like "Heure:" Then
                    F1.Cells(i, "B").Copy
                    F2.Cells(2, L).PasteSpecial Paste:=xlPasteValues
                    Application.CutCopyMode = False
                    F2.Cells(2, L).NumberFormat = "[$-F400]h:mm:ss AM/PM"
                End If
                If F2.Cells(2, L) <> "" Then L = L + 1
             Next i
 
 
    Set m = Nothing
    Set F1 = Nothing
    Set F2 = Nothing
 
End Sub

Merci par avance.

En PJ le fichier

[Jean-Philippe André]

Salut,

je ne comprends pas trop ton bloc de code avec ton dictionnaire.

ton code a trop peu de commentaires pour qu'on sache exactement ce que tu souhaites en faire.

Dans le dernier bloc de code, pourquoi faire à chaque ligne un changement de numberformat, alors que tu peux le faire en une seule fois

Code :

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

F2.Range(F2.Cells(2, 2),F2.Cells(2, L)).NumberFormat = "[$-F400]h:mm:ss AM/PM"

Bref, oui il est très probable d'avoir plein d'.optimisation, mais ton sujet est peut être connu de ceux qui t'ont aidé jusqu'à présent,. mais je n'ai pas assez de munitions pour t'aider plus pour l'instant

[Alex020181]

Bonjour,

Je te propose une version qui fait le job.

Tes tableaux de mesures ont tous le même nombre de lignes et de colonnes alors je me suis servi de cette particularité plutôt que de balayer pour trouver les mots clés comme le code déjà existant.

Le fichier est maintenant trop lourd. J'ai créé un lien sur smach (valable jusqu'au 9/7)

https://fromsmash.com/transpose-data

Teste et dis nous.

[pat91]

Bonjour Jean-Philippe André,

je ne comprends pas trop ton bloc de code avec ton dictionnaire.

j'ai été aidé pour ce bout de code, mais si j'ai bien compris cela permet de lister le nb de valeur de la première ligne du tableau pour restituer le même nb de ligne dans le feuille suivante et placer l'ensemble des colonnes de chaque tableau sur une unique colonne. Les données étant constituées de X tableau de 26 lignes et de 64 colonnes. Les données de chaque tableau devant être restituées sur une colonne pour avoir l'ensemble des tableaux mis cote à cote de colonne en colonne. j'espère avoir pu éclairé ta lanterne pour mieux comprendre le but final..

Dans le dernier bloc de code, pourquoi faire à chaque ligne un changement de numberformat, alors que tu peux le faire en une seule fois

Hé oui erreur de débutant, mais j'en ferais certainement d'autre.

Bonjour Alex020181,

Alors là ! chapeau c'est super efficace ce code, j'en suis resté baba, si si.
Bon ,je l'ai regardé en détail pour l'éplucher et "essayer" de le digérer et le comprendre, mais c'est chaud pour moi.
par contre j'ai modifié le type de données des "tablo" en double plutôt qu'en string, car cette synthèse est reprise sur un autre fichier de calcul et le string était "trop juste"

j'ai fait le test en chargeant dans la feuille BDD 800 tableaux de mesures et résultat retourné en 10 s ! c'est Nickel

Merci à vous deux pour votre aide, bonne journée

[Alex020181]

Super si tu as des résultats mais vérifie surtout s'ils sont corrects.

De mon côté j'ai vérifié par logique et échantillonnages mais toi tu sais précisément de quoi tu parles alors tu peux vérifier en profondeur.

Pour expliquer le code:
Tu as une première fonction (lanceur) qui appelle autant de fois que tu as de tableaux une deuxième fonction.
Cette deuxième fonction prend les valeurs de BDD colonne par colonne du tableau en cours de reprise et les stocke en mémoire dans un tableau. Une fois que toutes les colonnes de ce tableau de mesure est mémorisé les valeurs sont reportées dans la feuille synthèse. C'est tout (dans les grandes lignes).

En fait tu as 3 points clés à comprendre pour ce code;
- l'appel de fonction avec paramètres
- les boucles (ici boucle "for")
- les tableaux mémoire

Le reste c'est du standard mais suppose que tes tableaux aient toujours le même format, que tu aies bien toujours qu'une seule ligne de séparation entre chaque tableau, que tes en-têtes soient toujours dans le même ordre.

Pas de soucis pour ta transformation du typage de valeur sous réserve que toutes tes mesures soient bien des doubles (pas de texte par exemple) sinon ça plantera. Pour ça que j'avais mis des strings (sans jeu de mot (ou presque)).

Je n'ai pas mis de commentaires dans le code car il n'y en avait pas dans celui que tu as donné. J'ai donc supposé que tu savais "lire" le VBA.