Optimisation d'un programme sur l'insertion de données dans un tableau de bord "Excel" par VBA

**BDA53** · 04/04/2016, 11h42

à tous les collègues de la communauté de VBA.

Voici mon problème :

Dans le cadre d'un projet, on m'a confié la tâche d'élaborer un outil avec VBA qui a pour but de faire des tableaux de bords.
Pour ce faire, je dois insérer des résultats issus d'une base de données dans un nouveau fichier Excel contenant un tableau de bord.
Ces résultats sont des comptages réalisées sur des trains en fonction d'une fiche horaire proposée pour une journée.
Cette fiche horaire est donnée pour chaque gare où le train va s'arrêter.

Plusieurs critères sont à prendre en compte :

Les résultats sont rentrés à partir d'un numéro présent dans la base de données et dans le tableau de bord. Il suffit de faire une test d'égalité
Le tableau de bord est séparé en deux parties : insertion de la fiche horaire et insertion du tableau de résultats
Le tableau de résultats propose 2 résultats par gare. Il faut donc faire une insertion de valeurs "deux par deux"
Le tableau propose à la fin des lignes supplémentaires contenant des indicateurs. Les formules sont à rajouter avec VBA

J'ai réalisé ce programme pour répondre à cette commande.
Le souci c'est que ce programme est très volumineux.
Ce qui fait qu'Excel plante au milieu du code par manque de puissance.

Je vous demande (si c'est possible) de jeter un coup d'oeil à ce code et de me dire si le code peut être simplifié à certaines étapes.
Ce coup de main serait une aide très précieuse.
Je vous remercie d'avance pour le temps que vous m'accorderez sur ce problème.

Attention, je suis toujours en apprentissage sur VBA alors le code pique les yeux

:

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
'Procédure dans le but d'ajouter automatiquement les données des comptages réalisées
 
Sub Actualiser_Donnees()
 
    Dim ligne, colonne, horaire, indice, num_feuille As Integer
    Dim feuille As Worksheet
    Dim base As Object
 
    'Récupération du fichier de la base de comptage (=BDC)
    Set base = GetObject("chemin du fichier base de comptage")
 
    'Initialisation des variables num_feuille et colonne
    num_feuille = Worksheets(1).Range("C6")
    colonne = 2
    indice = 25
    horaire = 7
 
    'Pour chaque ligne de BDC
    Do Until Worksheets(num_feuille).Cells(horaire, "A") = "Temps de parcours"
 
        For ligne = 2 To 7000
 
    'Initialisation des variables indice et horaire correspondant au début du TDB et de la fiche horaire.
 
    'Si le numéro de train de la ligne de BDC et le même que pour la ième-colonne de TDB alors
            If base.Worksheets(1).Cells(ligne, "A") = Worksheets(num_feuille).Cells(3, colonne) Then
 
    'Insertion de la date et du numéro du jour
                Worksheets(2).Cells(22, colonne) = base.Worksheets(1).Cells(ligne, "N")
                Worksheets(2).Cells(23, colonne) = base.Worksheets(1).Cells(ligne, "D")
 
    'Si le date de la ième-colonne de TDB est différente de la ligne choisie de BDC en colonne "n" alors
    'On passe à la colonne suivante et on remet à jour la variable indice
                If Worksheets(num_feuille).Cells(22, colonne) <> base.Worksheets(1).Cells(ligne, "N") Or Worksheets(num_feuille).Cells(indice, colonne) = "Total Montées" Then
                    colonne = colonne + 1
                    indice = 25
                    horaire = 7
                End If
 
    'Si la valeur de la fiche horaire est vide alors on saute des lignes dans le TDB et on ne fait rien.
    'Cela se fait jusqu'à la fin de la fiche horaire, c'est à dire quand le programme tombe sur le libellé "temps de parcours"
 
                    If Worksheets(num_feuille).Cells(horaire, colonne) <> "" Then
    'Insertion des données "montées" et "descentes"
                        Worksheets(num_feuille).Cells(indice, colonne) = base.Worksheets(1).Cells(ligne, "F")
                        Worksheets(num_feuille).Cells(indice + 1, colonne) = base.Worksheets(1).Cells(ligne, "G")
                    End If
 
    'Incrémentation des variables indice et horaire
                    indice = indice + 2
                    horaire = horaire + 1
 
            End If
 
        Next ligne
 
    Loop
 
End Sub

Voilà j'espère que vous avez compris ce que je recherche.
C'est difficile de comprendre la demande quand on ne connaît pas le sujet.
Et surtout je ne suis pas sur d'avoir bien expliqué le problème.
S'il y a besoin je peux préciser davantage certains points à aborder

.

**Philippe PONS** · 04/04/2016, 11h52

Salut

tu peux déja améliorer les perf avec ça:

Code :

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

1
2
3
4
5
6
 ' à mettre tout au début
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 ' à mettre à la fin
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

Cordialement,

**thebenoit59** · 04/04/2016, 12h13

Bonjour xela57 et Philippe.

Pourrais-tu joindre un fichier exemple pour travailler dessus ? Cela permettra de tester les performances.

**BDA53** · 04/04/2016, 13h56

Merci pour vos réponses.
J'ai testé ce code

Code :

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

1
2
3
4
5
6
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Cela ne change rien.
Je pense que le programme est toujours la cause du plantage.

En ce qui concerne le programme, je ne peux pas transmettre le fichier par souci de confidentialité.
Ce que je peux faire c'est faire des captures d'écrans de la commande souhaitée

**thebenoit59** · 04/04/2016, 14h16

Et tu ne pourrais pas modifier les données avec des données "bidons" ?
Cela serait bien plus simple pour comprendre le fonctionnement.

**Philippe PONS** · 04/04/2016, 14h17

Dans ton message tu dis que le code plante!
Il plante sur quelle instruction?
Quel est le message d'erreur?

**vinc_bilb** · 04/04/2016, 14h43

Bonjour,

Sans rentrer en profondeur dans le code, je vois la méthode qui me fait dresser les cheveux sur la tête mais par laquelle nous sommes tous passé je pense ..... (en tout cas, moi)

Exemple:

Code :

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

1
2
    'Pour chaque ligne de BDC
    Do Until Worksheets(num_feuille).Cells(horaire, "A") = "Temps de parcours"

=> Surtout pas! C'est très très lent, vous pouvez gagner un facteur 10 sans pb en passant par un filtre ou un autofiltre et de récupérer le résultat

Voir par ci-dessous une base de filtrage d'une table. Vous pouvez avantageusement regarder les tutoriaux sur les filtres et autofiltres

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
Function FilterTabl(Wsh As Worksheet, TablObjN As String, FiltFiledI As Integer, FiltCriterV As Variant, Optional RetBodyRngB As Boolean = True) As Range
' Filter a table and return the range after filtering
 
ProcNameS = "FilterTabl"
 
    Dim WshProtB As Boolean
    Dim TablO As Object
 
' Init
    On Error GoTo Err_FilterTabl
 
    Set TablO = Wsh.ListObjects(TablObjN)
 
' Remove the previous filter if any
    Call ClearFilterTabl(Wsh, TablObjN)
    TablO.Range.AutoFilter
' Filter
    TablO.Range.AutoFilter Field:=FiltFiledI, Criteria1:=FiltCriterV
 
    If RetBodyRngB = False Then
 
        Set FilterTabl = TablO.Range.SpecialCells(xlCellTypeVisible)
        Else: Set FilterTabl = TablO.DataBodyRange.SpecialCells(xlCellTypeVisible)
 
    End If
 
    Debug.Print FilterTabl.AddressLocal, FilterTabl.Rows.Count
 
    If FilterTabl.Cells.Count <= FilterTabl.Columns.Count Then
        MsgBox TablObjN & vbCrLf & "Warning: returned range has " & FilterTabl.Rows.Count & " row", vbExclamation, ProcNameS
    End If
 
 
Err_FilterTabl:
 
    If Err.Number <> 0 Then
 
        Warnmsg = "Error: " & Err.Number & vbCrLf & Err.Description
        MsgBox Warnmsg, vbExclamation, ProcNameS
        Err.Clear
        Exit Function
 
    End If
 
End Function

Bon courage

**BDA53** · 04/04/2016, 14h53

J'ai essayé mais le fichier est trop volumineux (+ de 16 Mo).

Par rapport au plantage du programme : Aucun message d'erreur s'affiche.
Aucune ligne n'est pointée et aucun débogage ne s'affiche.
En fait c'est Excel qui se met en mode "ne répond pas".
Je n'ai qu'une seule option, relancer le programme.

**halaster08** · 04/04/2016, 15h13

En fait c'est Excel qui se met en mode "ne répond pas".
Je n'ai qu'une seule option, relancer le programme.

Combien de temps attends tu avant de relancer le programme?
Je travaille aussi avec des fichiers volumineux et bien que excel me dise régulièrement qu'il "ne répond pas", ça veut plutôt dire "vas prendre ton café humain, je bosse".
Parfois quand je travaille vraiment avec trop de données après le "ne répond pas" j'ai un message d'erreur.
A mon avis tant qu'il ne t'affiche pas de message essaye de le laisser tourner.

**BDA53** · 06/04/2016, 12h10

Merci vinc je vais essayer avec la fonction des auto filtres.
Néanmoins, peux-tu me donner un exemple d'utilisation de la fonction ?
J'avoue que j'ai un peu du mal avec cette toute nouvelle fonction

halaster j'ai déjà essayé de le laisser bosser.
Une fois je l'ai laissé tourner pendant 30 min pour voir s'il allait m'afficher un message d'erreur.
Mais rien, toujours le même souci "Excel ne répond pas"...

Toutefois, j'ai échangé avec un collègue qui m'a appris qu'Excel 2010 est en grande difficulté s'il est installé sur un ordinateur avec un système d'exploitation à 32 bits et une mémoire vive de 2 Go.

Quand on fait de la programmation VBA sur Excel 2010, il faut de préférence un ordinateur avec un système de 64 bits et une mémoire vive de 4Go.

**halaster08** · 06/04/2016, 14h49

Une fois je l'ai laissé tourner pendant 30 min pour voir s'il allait m'afficher un message d'erreur.
Mais rien, toujours le même souci "Excel ne répond pas"...

Effectivement 30 minute c'est étonnant que tu n'ai pas eu de m'essage d'erreur

J'ai essayé mais le fichier est trop volumineux (+ de 16 Mo).

Toutefois, j'ai échangé avec un collègue qui m'a appris qu'Excel 2010 est en grande difficulté s'il est installé sur un ordinateur avec un système d'exploitation à 32 bits et une mémoire vive de 2 Go.
Quand on fait de la programmation VBA sur Excel 2010, il faut de préférence un ordinateur avec un système de 64 bits et une mémoire vive de 4Go.

64bits et 4Go de RAM c'est effectivement ma config au bureau, mais avec ça je fais tourner des fichiers bien plus volumineux que 16Mo (le plus gros est un peu au dessus de 60Mo) et ma responsable qui utilise un pc portable moins puissant que le mien arrive a faire tourner les fichiers aussi (bien ce soit un peu plus long). Après je suis pas expert et je ne me rends pas bien compte de l'impact de la différence 32-64bits mais je trouve ça étonnant quand même.

As tu essayé de faire tourner ton programme sur un autre PC?

**BDA53** · 06/04/2016, 14h58

Non je ne l'ai pas encore testé sur un autre PC.
Effectivement je trouve ça très étrange aussi.

Mais j'ai trouvé une solution intermédiaire à mon problème. J'ai remplacé la boucle pré-testé do Until par une boucle for.
Le programme a gagné en ergonomie et s’exécute correctement.

Maintenant c'est un autre problème qui se pose.
Je vais l'exposer dans un autre post vu que ce n'est plus du tout en rapport avec l'objet de ce post.

Merci à vous tous pour vos réponses, cela m'a beaucoup aidé dans la résolution