Discussion :

[BDA53]

à 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]

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]

Bonjour xela57 et Philippe.

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

[BDA53]

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]

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]

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

[vinc_bilb]

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]

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.