Lenteur VBA selon le type de lancement

Version imprimable

Bonjour à tous,

J'ai un pb et je ne trouve pas de solution...

Explication :
lorsque je lance ma macro (voir après) dans "microsoft VBA" (la console VBA) elle fait son action sur excel en 14 sec (je vois "travailler" excel en parallèle). Mais quand je la lance à partir d'excel avec un bouton : elle prends plus de 3x le temps !!!

Je ne suis pas programmateur, mais j'ai l'habitude des macros et ça m'arrive uniquement avec cette macro ?!?.

j'ai essayé avec ce qui suit en début de macro mais pas d'amélioration :

Code:

1
2
Application.ScreenUpdating = False 'Arrête certains calculs automatiques
Application.EnableEvents = False ' => désactive les événements

Donc merci de vos idées par avance. je suis sec :piou:

Voici le code:

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub recuperer_dataactuellecomplet()
On Error GoTo ErrorHandler
'Application.ScreenUpdating = False 'Arrête certains calculs automatiques
'Application.EnableEvents = False ' => désactive les événements
'cette macro va ecrire tous les fichiers !!! eviter de l'utiliser !!!
 
Dim col_1_plan, col_fin_plan, lig_1_plan, lig_fin_plan
Dim repert As String
Dim inc_l, inc_col
Dim fic As String
Dim nom_fichier
Dim tabl(8) 'tableau pour transfert des données
 
'lectures des variables
lig_1_plan = Sheets("data_macro").Range("B12")
col_1_plan = Sheets("data_macro").Range("B13")
lig_fin_plan = Sheets("data_macro").Range("B14")
col_fin_plan = Sheets("data_macro").Range("B15")
repert = Sheets("data_macro").Range("B10")
 
'déclaration variables incrémentation
inc_l = lig_1_plan
 
 
 
While inc_l <= lig_fin_plan
    inc_col = col_1_plan 'déclaration variables incrémentation
 
    While inc_col <= col_fin_plan
        nom_fichier = inc_l * 10000 + inc_col
        fic = repert & nom_fichier & ".csv"
 
        Open fic For Input As #1 'lecture
        Line Input #1, tabl(1)
        Line Input #1, tabl(2)
        Line Input #1, tabl(3)
        Line Input #1, tabl(4)
 
        Close #1
 
        Sheets("Feuil1").Cells(inc_l, inc_col) = tabl(1) 'ecriture
        Sheets("Feuil1").Cells(inc_l, inc_col + 1) = tabl(2)
        Sheets("Feuil1").Cells(inc_l, inc_col + 2) = tabl(3)
        Sheets("Feuil1").Cells(inc_l, inc_col + 3) = tabl(4)
 
        inc_col = inc_col + 4
    Wend 'inc_col
 
    inc_l = inc_l + 1
 
Wend 'inc_l
MsgBox "Terminé avec succès"
 
'Application.ScreenUpdating = True 'Réactive les calculs.
'Application.EnableEvents = True ' => réactive les événements
    Exit Sub
ErrorHandler:
    'Le code qui s'execute si il y a une erreur
 
    Dim MonResultat
    MonResultat = MsgBox("Une erreur s'est produite. numéro fichier : " & nom_fichier & "   , contacter P" & vbCrLf & vbCrLf & "Erreur n° " & Err.Number & vbCrLf & "Description : " & Err.Description, vbCritical + vbOKOnly, "Erreur d'execution")
 
End Sub

27/03/2020, 12h37
PP_63

Trouvé je pense

j'ai ajouté une "vidange" de tableau à la fin du code. ce n'est pas beaucoup mieux.

Ce qui est bizarre, c'est que si je le lance dans microsfot VBA, je peux le faire autant de fois que je veux, pas de pb (sans le "erase") ?!?

voici le rajout en fin de code:

Code:

Erase tabl

Bonjour,

Bien que je n'aie pas d'idée de la raison pour laquelle il y ait une différence dans les temps d'exécution selon le mode de lancement de la macro, tester celle-ci:

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
Sub recuperer_dataactuellecomplet()
    'Application.ScreenUpdating = False 'Arrête certains calculs automatiques
    'Application.EnableEvents = False   ' => désactive les événements
    'cette macro va ecrire tous les fichiers !!! eviter de l'utiliser !!!
    Dim col_1_plan, col_fin_plan, lig_1_plan, lig_fin_plan
    Dim inc_l, inc_col
    Dim repert As String, fic As String, nom_fichier As String
    Dim tabl(8) '--- tableau pour transfert des données
    Dim wSh As Worksheet
    lig_1_plan = Sheets("data_macro").Range("B12")
    col_1_plan = Sheets("data_macro").Range("B13")
    lig_fin_plan = Sheets("data_macro").Range("B14")
    col_fin_plan = Sheets("data_macro").Range("B15")
    repert = Sheets("data_macro").Range("B10")
    Set wSh = Worksheets("Feuil1")
    With wSh
        inc_l = lig_1_plan                              '--- ligne incrémentation
        While inc_l <= lig_fin_plan
            inc_col = col_1_plan                        '--- colonne incrémentation
            While inc_col <= col_fin_plan
                nom_fichier = inc_l * 10000 + inc_col
                fic = repert & nom_fichier & ".csv"
                Open fic For Input As #1                '--- lecture
                   Line Input #1, tabl(1)
                   Line Input #1, tabl(2)
                   Line Input #1, tabl(3)
                   Line Input #1, tabl(4)
                Close #1
                .Cells(inc_l, inc_col) = tabl(1)        '--- ecriture
                .Cells(inc_l, inc_col + 1) = tabl(2)
                .Cells(inc_l, inc_col + 2) = tabl(3)
                .Cells(inc_l, inc_col + 3) = tabl(4)
                inc_col = inc_col + 4
            Wend                                        'inc_col
            inc_l = inc_l + 1
        Wend                                            'inc_l
    End With
    Set wSh = Nothing
    MsgBox "Terminé avec succès"
    'Application.ScreenUpdating = True 'Réactive les calculs.
    'Application.EnableEvents = True ' => réactive les événements
End Sub

Cordialement.

29/03/2020, 00h11
PP_63

Test solution EricDgn

Merci EricDgn,

je viens d'essayer avec une feuille vide. ça à l'air pas mal. il faut que j'injecte ça dans le vrai programme et que je teste. Je te tiens au courant.

:D
29/03/2020, 17h42
PP_63

EricDgn - ne marche pas

Bonjour,
EricDgn : la solution dans mon fichier ne marche pas !!!

Par contre, je remarque que je gagne en vitesse (même avec mon programme original) lorsque mon pointeur est sur le bandeau excel et quand j'ai le pointeur sur les "carreaux" du tableau excel, je perds en vitesse !!!

:piou:

Quelqu'un aurait une idée ?
29/03/2020, 18h11
Patrice740

Bonjour,

« Ne marche pas » autant de détails vont vraiment aider à comprendre pourquoi !

N'y a t'il que cette procédure dans le fichier ?
Pas de procédure évènementielle ?

Bonjour,

A tester: suspendre les calculs et/ou le rafraichissement du curseur pendant l'exécution de la macro.
Code:

1 2 3 4 5 Application.Calculation = xlManual Application.Cursor = xlWait '... Application.Cursor = xlDefault Application.Calculation = xlAutomatic
Cordialement.

30/03/2020, 07h49
Transitoire

Bonjour,

Citation:

Application.ScreenUpdating = True 'Réactive les calculs.

application.ScreenUpDating = true ne réactive pas les calculs mais effectue un rafraichissement de l'écran, ce qui peut être gourmand en temps d'exécutions et désagréable à la vue. la permission des calculs est donnée par le code de #EricDgn.
Les détails des problèmes manquent cruellement de précisions.
N'avez vous pas sur la partie code de la feuille active ou le classeur actif, des macros particulières puisque vous parlez de modifications des délais suivant la position du pointeur? (Si j'ai tout bien compris):weird:
En tout cas, si les délais ne sont pas les mêmes, il semblerait que cela soit à cause d'évènements déclenchés automatiquement. :aie:
Cordialement 8-)
30/03/2020, 16h33
PP_63

Merci - Solution
Citation:
Envoyé par EricDgn

Bonjour,

A tester: suspendre les calculs et/ou le rafraichissement du curseur pendant l'exécution de la macro.

Code:

1 2 3 4 5 Application.Calculation = xlManual Application.Cursor = xlWait '... Application.Cursor = xlDefault Application.Calculation = xlAutomatic

Cordialement.
Bonjour à vous deux,

Tout d'abord, merci à vous deux, la solution est celle ci-dessus. Effectivement, j'ai des macros qui peuvent se lancer mais je pense (ou pensais) qu'avec "Application.EnableEvents = False" ça suffisait?
Enfin, le principale est d'avoir trouvé.

Mes messages manquaient sûrement de détail. Mais je savais que quelqu'un avait la solution (même sans les détails) et je n'avais pas beaucoup de temps de détailler. :calim2:

Je mets en résolu.
:lol: