Performance Macro à une boucle

**Hugo D** · 19/06/2019, 16h31

Bonjour ,

J'ai rédigé une macro assez simple qui me permet de mettre à jour une base de donnée excel ("Suivi") à partir d'une autre ("Import").
La feuillle ("Inter") est une feuille intermédiaire qui me permet de concaténer deux informations de mes bases de données afin que le find soit plus efficace (cela me fait une boucle en moins)
La feuille ("Liste") est une base de correspondance entre des types de matricules différents

D'après mon expérience sur ce type de code je m'attendais à une ou deux minutes pour traiter quelques milliers de ligne, mais là j'en suis à environ 40 secondes de traitement pour 100 ligne à peine et excel ne supporte pas le traitement de 2 000 lignes qui sera à peu près la taille standard des données à traiter.

Auriez vous des conseils pour simplifier encore le code (même s'il est pour moi déjà bien épuré) mais surtout pour améliorer la vitesse d’exécution qui n'est pas standard pour moi.

Merci d'avance

Cordialement

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
Application.ScreenUpdating = False
 
NBLigSuivi = Application.CountA(Worksheets("Suivi").Range("B:B")) + 1
NbLigImport = Application.CountA(Worksheets("Import").Range("A:A"))
 
For i = 2 To NbLigImport
    If Worksheets("Inter").Range("A:A").Find(Worksheets("Inter").Cells(i - 1, 2), LookIn:=xlValues) Is Nothing Then
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 1) = Worksheets("Listes").Cells(Worksheets("Listes").Range("D:D").Find(Worksheets("Suivi").Cells(i, 29)).Row, 3)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 2) = Worksheets("Import").Cells(i, 2)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 3) = Worksheets("Import").Cells(i, 9)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 4) = Worksheets("Import").Cells(i, 22)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 5) = Worksheets("Import").Cells(i, 10)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 6) = Worksheets("Import").Cells(i, 13)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 7) = Worksheets("Import").Cells(i, 19)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 8) = Worksheets("Import").Cells(i, 20)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 9) = Worksheets("Import").Cells(i, 8)
        Worksheets("Suivi").Cells(NBLigSuivi + 1, 15) = Worksheets("Import").Cells(i, 18)
        NBLigSuivi = NBLigSuivi + 1
 
    Else
 
        j = Worksheets("Inter").Range("A:A").Find(Worksheets("Inter").Cells(i - 1, 2), LookIn:=xlValues).Row + 2
        Worksheets("Suivi").Cells(j, 1) = Worksheets("Listes").Cells(Worksheets("Listes").Range("D:D").Find(Worksheets("Suivi").Cells(i, 29)).Row, 3)
        Worksheets("Suivi").Cells(j, 2) = Worksheets("Import").Cells(i, 2)
        Worksheets("Suivi").Cells(j, 3) = Worksheets("Import").Cells(i, 9)
        Worksheets("Suivi").Cells(j, 4) = Worksheets("Import").Cells(i, 22)
        Worksheets("Suivi").Cells(j, 5) = Worksheets("Import").Cells(i, 10)
        Worksheets("Suivi").Cells(j, 6) = Worksheets("Import").Cells(i, 13)
        Worksheets("Suivi").Cells(j, 7) = Worksheets("Import").Cells(i, 19)
        Worksheets("Suivi").Cells(j, 8) = Worksheets("Import").Cells(i, 20)
        Worksheets("Suivi").Cells(j, 9) = Worksheets("Import").Cells(i, 8)
        Worksheets("Suivi").Cells(j, 15) = Worksheets("Import").Cells(i, 18)
 
    End If
Next
 
Application.ScreenUpdating = True

**Transitoire** · 19/06/2019, 18h35

Bonsoir, soyez gentil de penser à mettre votre code avec balise dièse (#) c'est plus simple à lire. merci!

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
Application.ScreenUpdating = False
 
NBLigSuivi = Application.CountA(Worksheets("Suivi").Range("B:B")) + 1
NbLigImport = Application.CountA(Worksheets("Import").Range("A:A"))
 
For i = 2 To NbLigImport
If Worksheets("Inter").Range("A:A").Find(Worksheets("Inter").Cells(i - 1, 2), LookIn:=xlValues) Is Nothing Then
Worksheets("Suivi").Cells(NBLigSuivi + 1, 1) = Worksheets("Listes").Cells(Worksheets("Listes").Range("D").Find(Worksheets("Suivi").Cells(i, 29)).Row, 3)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 2) = Worksheets("Import").Cells(i, 2)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 3) = Worksheets("Import").Cells(i, 9)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 4) = Worksheets("Import").Cells(i, 22)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 5) = Worksheets("Import").Cells(i, 10)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 6) = Worksheets("Import").Cells(i, 13)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 7) = Worksheets("Import").Cells(i, 19)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 8) = Worksheets("Import").Cells(i, 20)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 9) = Worksheets("Import").Cells(i, 8)
Worksheets("Suivi").Cells(NBLigSuivi + 1, 15) = Worksheets("Import").Cells(i, 18)
NBLigSuivi = NBLigSuivi + 1
 
Else
 
j = Worksheets("Inter").Range("A:A").Find(Worksheets("Inter").Cells(i - 1, 2), LookIn:=xlValues).Row + 2
Worksheets("Suivi").Cells(j, 1) = Worksheets("Listes").Cells(Worksheets("Listes").Range("D").Find(Worksheets("Suivi").Cells(i, 29)).Row, 3)
Worksheets("Suivi").Cells(j, 2) = Worksheets("Import").Cells(i, 2)
Worksheets("Suivi").Cells(j, 3) = Worksheets("Import").Cells(i, 9)
Worksheets("Suivi").Cells(j, 4) = Worksheets("Import").Cells(i, 22)
Worksheets("Suivi").Cells(j, 5) = Worksheets("Import").Cells(i, 10)
Worksheets("Suivi").Cells(j, 6) = Worksheets("Import").Cells(i, 13)
Worksheets("Suivi").Cells(j, 7) = Worksheets("Import").Cells(i, 19)
Worksheets("Suivi").Cells(j, 8) = Worksheets("Import").Cells(i, 20)
Worksheets("Suivi").Cells(j, 9) = Worksheets("Import").Cells(i, 8)
Worksheets("Suivi").Cells(j, 15) = Worksheets("Import").Cells(i, 18)
 
End If
Next
 
Application.ScreenUpdating = True

Cordialement

**marot_r** · 19/06/2019, 18h47

Bonjour.

Essaye en ajoutant

Application.Calculation=xlCalculationManual avant le For et Application.Calculation=xlCalculationAutomatic après le Next.

A+

**John Mc Evee** · 19/06/2019, 21h45

Bonjour Hugo et le forum

A vrai dire, je n'ai jamais cherché à comprendre se qui mobilise la puissance de calcul, mais quand j'ai vu ton code, je me suis dit qu'il est possible qu'Excel rame à cause des appels de feuille (Worksheet("Nom")). A chaque fois, il doit créer un nouvelle espace en mémoire pour la feuille Excel et ainsi de suite (A vérifier avec des spécialistes Excel). Dans tous les cas, je te conseille de fixer tes feuilles de travail et d'utiliser le mot clé With sur ta feuille principal (Ici Suivi).

Voici le même code avec un fixe sur les feuilles. Dit moi si cela améliore la productivité de ta macro ?

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
 
Dim WsSuivi as Worksheet
Dim WsInter as Worksheet
Dim WsImport as Worksheet
Dim WsListe as Worksheet
 
Application.ScreenUpdating = False
 
'Fixe les feuilles
 
Set WsSuivi = Worksheets("Suivi")
Set WsInter = Worksheets("Inter")
set WsImport = Worksheets("Import")
Set WsListe = Worksheets("Listes")
 
with WsSuivi
 
    NBLigSuivi = WorksheetFunction.CountA(.Range("B:B")) + 1
    NbLigImport = WorksheetFunction.CountA(WsImport.Range("A:A"))
 
    For i = 2 To NbLigImport
 
        If WsInter.Range("A:A").Find(WsInter.Cells(i - 1, 2), LookIn:=xlValues) Is Nothing Then
 
            .Cells(NBLigSuivi + 1, 1) = WsListe.Cells(WsListe.Range("D:D").Find(.Cells(i, 29)).Row, 3)
            .Cells(NBLigSuivi + 1, 2) = WsImport.Cells(i, 2)
            .Cells(NBLigSuivi + 1, 3) = WsImport.Cells(i, 9)
            .Cells(NBLigSuivi + 1, 4) = WsImport.Cells(i, 22)
            .Cells(NBLigSuivi + 1, 5) = WsImport.Cells(i, 10)
            .Cells(NBLigSuivi + 1, 6) = WsImport.Cells(i, 13)
            .Cells(NBLigSuivi + 1, 7) = WsImport.Cells(i, 19)
            .Cells(NBLigSuivi + 1, 8) = WsImport.Cells(i, 20)
            .Cells(NBLigSuivi + 1, 9) = WsImport.Cells(i, 8)
            .Cells(NBLigSuivi + 1, 15) = WsImport.Cells(i, 18)
            NBLigSuivi = NBLigSuivi + 1
 
        Else
 
            j = WsInter.Range("A:A").Find(WsInter.Cells(i - 1, 2), LookIn:=xlValues).Row + 2
            .Cells(j, 1) = WsListe.Cells(WsListe.Range("D:D").Find(.Cells(i, 29)).Row, 3)
            .Cells(j, 2) = WsImport.Cells(i, 2)
            .Cells(j, 3) = WsImport.Cells(i, 9)
            .Cells(j, 4) = WsImport.Cells(i, 22)
            .Cells(j, 5) = WsImport.Cells(i, 10)
            .Cells(j, 6) = WsImport.Cells(i, 13)
            .Cells(j, 7) = WsImport.Cells(i, 19)
            .Cells(j, 8) = WWsImport.Cells(i, 20)
            .Cells(j, 9) = WsImport.Cells(i, 8)
            .Cells(j, 15) = WsImport.Cells(i, 18)
 
        End If
    Next
 
end with
 
Set WsSuivi = Nothing
Set WsInter = Nothing
set WsImport = Nothing
Set WsListe = Nothing
 
Application.ScreenUpdating = True

En parcourant le forum, j'ai trouvé un site qui explique des optimisations en VBA --> Site

A+

**clementmarcotte** · 19/06/2019, 23h36

Bonjour,

Moi, je dirais que ce n'est pas trop tôt pour lire ce fil.

ET que je suis toujours d'accord avec moi-même,

Extrait:

Ceci étant dit, la grande faiblesse d'Excel c'est qu'il a toujours besoin de la totalité (en nombre et en octets) des classeurs qu'il a ouverts en mémoire vive pour fonctionner. Ce n'est pas Access qui peut travailler avec des parties de fichiers qui restent sur le disque. Dès que Windows a de la difficulté à fournir la mémoire vive dont Excel a besoin; c'est la porte ouverte à des corruptions de fichiers et à des plantages en tous genres. Et comme Windows tolère un paquet de Belzébuths automatiques qui décollent n'importe quand sans avertir; rien n'indique que si tu as sassez de mémoire vive disponible au début, tu en auras assez deux minutes plus tard…

Et que faire de la gestion de données dans Excel c'est suicidaire. Et si cela ne marche pas pour 2000 lignes, le mur n'est pas loin.

Et quand je pense qu'il y a une version gratuite de SQLServer dans Visual Studio Community (gratuit pour les particuliers et les petites équipe de programmeurs), et que SQLServer Express (plus puissant) est aussi gratuit que et d'autres SGBD sont aussi gratuits, il n'y a aucun mérite, ni aucune excuse pour avoir des "bases de données" avec Excel. Bon OK, j'en ai une pour conserver des pointages de Yathzee, en attendant de programmer en VB les fonctions d'Excel dont j'ai besoin, mais des données commerciales et financières jamais.

P.S. Au lieu de promener des données sur trois feuilles, regarde ceci. Tu devras adapter er trouver la requête SQL qui va bien.

**Hugo D** · 20/06/2019, 09h38

Bonjour à tous,

Merci pour vos réponses et votre réactivité, c'est génial !

J'ai commencé par la solution de Maro r qui était la plus simple à appliquer et qui faisait plutôt sens parce que j'avais encore deux colonnes de formules que j'hésitais à passer dans la macro.

Les 100 lignes sont passées de 40 secondes de traitement à moins d'une seconde !

Je vais quand même explorer les autres solutions, ne serait-ce que pour ma culture.

Merci encore

Cordialement

Hugo D

Performance Macro à une boucle [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager