Discussion :

[Floyd-44]

Bonjour,

J'ai un petit soucis de temps sur une boucle qui marche très bien mais nécessite beaucoup de patience. J'ai cru comprendre que les modules de classes m'aideraient pour ça mais après lu et relu la doc il faut avouer que c'est assez obscure pour moi.
Si quelqu'un a une bonne idée, je serais reconnaissant.

Merci d'avance

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
 
    If Feuil2.Range("I8") = "ACIER" Or Feuil2.Range("I8") = "ALU" Then
        Col = "G" 'Colonne G de l'onglet source pour Acier Alu
        NbLar = 8
        Nb_Ouv = 24500
        Nb_Ress = 122500
        Nb_Cumul = 147000
    Else
        Col = "H" 'Colonne H de l'onglet source pour le ZCI
        NbLar = 7
        Nb_Ouv = 21000
        Nb_Ress = 105000
        Nb_Cumul = 126000
    End If
    Lign = 7
    LinCol = 13
    Feuil2.Range("A" & Lign & ":T" & Lign + 5).Select
    Selection.Copy
    For NbLar = NbLar To 2 Step -1
        DevLar = Sheets("Source Produit").Range(Col & NbLar).Value
        For NbLong = 2 To 15
            DevLon = Sheets("Source Produit").Range("I" & NbLong).Value  'Feuil2.Range("A7:G7").Select
            For NbPli = 1 To 10
                For Mol = 0 To 4
                    For Enc = 0 To 4
                        Feuil2.Range("A" & LinCol).PasteSpecial (xlPasteAll)
                        Feuil2.Range("C" & LinCol).Value = NbPli
                        Feuil2.Range("D" & LinCol).Value = DevLar
                        Feuil2.Range("E" & LinCol).Value = DevLon
                        Feuil2.Range("F" & LinCol).Value = Mol
                        Feuil2.Range("G" & LinCol).Value = Enc
                        LinCol = LinCol + 6
                        Lign = Lign + 6
                    Next Enc
                Next Mol
            Next NbPli
        Next NbLong
    Next NbLar
    Application.CutCopyMode = False

[mfoxy]

Bonjour,

Pour mieux comprendre ton souci en tentant de bypasser les boucles.

Pourrais exprimer en français le but de tes boucles, il me semble qu'un filtrage élaboré et collage des résultat pourrait faire le job, mais t'avoue me perdre dans tes boucles imbriquées

[Alex020181]

Bonjour,

Pouvez-vous joindre un fichier exemple ? Je pense savoir comment accélérer tout ça.

[Patrice740]

Bonjour,

Au lieu d'écrire dans des cellules tu devrais construire un tableau VBA à 2 dimensions puis transférer le tableau sur la feuille.
Comme la plage à écrire semble de dimension prédéfinie, ça simplifie le code.
Ça ne devrais durer que quelques fractions de secondes.

[Patrice740]

Bonjour
,

Essaies comme ça (sans 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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    If Feuil2.Range("I8") = "ACIER" Or Feuil2.Range("I8") = "ALU" Then
        Col = "G" 'Colonne G de l'onglet source pour Acier Alu
        NbLar = 8
        Nb_Ouv = 24500
        Nb_Ress = 122500
        Nb_Cumul = 147000
    Else
        Col = "H" 'Colonne H de l'onglet source pour le ZCI
        NbLar = 7
        Nb_Ouv = 21000
        Nb_Ress = 105000
        Nb_Cumul = 126000
    End If
    Lign = 7
    LinCol = 13
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Feuil2.Range("A" & Lign & ":T" & Lign + 5).Copy Feuil2.Range("A" & Lign & ":T" & Lign + 126005)
    For NbLar = NbLar To 2 Step -1
        DevLar = Sheets("Source Produit").Range(Col & NbLar).Value
        For NbLong = 2 To 15
            DevLon = Sheets("Source Produit").Range("I" & NbLong).Value  'Feuil2.Range("A7:G7").Select
            For NbPli = 1 To 10
                For Mol = 0 To 4
                    For Enc = 0 To 4
                        Feuil2.Range("C" & LinCol).Value = NbPli
                        Feuil2.Range("D" & LinCol).Value = DevLar
                        Feuil2.Range("E" & LinCol).Value = DevLon
                        Feuil2.Range("F" & LinCol).Value = Mol
                        Feuil2.Range("G" & LinCol).Value = Enc
                        LinCol = LinCol + 6
                        Lign = Lign + 6
                    Next Enc
                Next Mol
            Next NbPli
        Next NbLong
    Next NbLar
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

[Alex020181]

Bonjour,

Au lieu d'écrire dans des cellules tu devrais construire un tableau VBA à 2 dimensions puis transférer le tableau sur la feuille.
Comme la plage à écrire semble de dimension prédéfinie, ça simplifie le code.
Ça ne devrais durer que quelques fractions de secondes.

Oui, c'est ce que je suis en train de faire.

[Patrice740]

Oui, c'est ce que je suis en train de faire.

Je l'ai fait et je ne l'ai pas proposé car c'est moins rapide, du fait de la nécessité de copier les formats de la plage à copier.

[Alex020181]

Voici un exemple de code pour créer votre tableau final.

Testez et dites-moi.

Par contre j'obtiens 126 000 lignes environ et pas 147 000. Même avec votre code d'origine.

[Patrice740]

Voici un exemple de code pour créer votre tableau final.
Testez et dites-moi.
Par contre j'obtiens 126 000 lignes environ et pas 147 000. Même avec votre code d'origine.

Il manque la copie des formats ..., sinon c'est a peu près ce j'avais testé : c'est plus lent que ce que j'ai proposé (j'ai aussi 126 005 lignes).

[Floyd-44]

Bonjour
,

Essaies comme ça (sans tableau) :

Code :

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

1
2
3
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

Bonjour,
J'ai en effet trouvé cette solution en un peu plus poussé encore sur un cours hier et qui porte les 147000 lignes à 7mn. C'est plutôt efficace
Pour la question des lignes:
Quand NbLar = 7 alors 126000 et 147 pour Nblar = 8

Code :

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

1
2
3
4
5
6
 
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

[Floyd-44]

Voici un exemple de code pour créer votre tableau final.
Testez et dites-moi

5 secondes et 16 centièmes.

C'est efficace. Seul problème, et c'est ma faute j'aurais du préciser, il me colle que du texte en faisant sauter les formules. Je suis en train d'essayer de regarder.

Merci encore

[Alex020181]

il me colle que du texte en faisant sauter les formules.

Pouvez-vous joindre un fichier exemple contenant vos formules ?
En résultat voulez-vous que les formules soient gardées ou que seuls leurs résultats soient affichés ?

[Floyd-44]

Voici un exemple de code pour créer votre tableau final.
Testez et dites-moi.
Par contre j'obtiens 126 000 lignes environ et pas 147 000. Même avec votre code d'origine.

J'ai passé pas mal de temps dessus pour adapter toutes les données à intégrer mais ça en valait largement la peine.

A peine plus de 7 secondes... Merci beaucoup pour ton aide

Sinon : NB_Lar = 7 dans ton exemple c'est pour ça, quant il est = à 8 tu trouveras les 147kLignes

Allez bon confinement...!

[Patrice740]

J'ai en effet trouvé cette solution en un peu plus poussé encore sur un cours hier et qui porte les 147000 lignes à 7mn. C'est plutôt efficace

7 mn ????
Chez moi le code que j'ai proposé ne met que 5 secondes (avec une UC 32 bits qui a 10 ans)

[Floyd-44]

7 mn ????
Chez moi le code que j'ai proposé ne met que 5 secondes (avec une UC 32 bits qui a 10 ans)

Parce que tu copie uniquement des valeurs tandis que le tableau (5,19) copié contient beaucoup de formules de type INDEX EQUIV, SOMME et PRODUIT avec des conditions SI etc...
Sur ta base, j'ai donc intégré la définition des valeurs dans le code et non dans la feuille, 6.54 secondes ce matin. Je te remercie