VBA rame jusqu'a planter Excel.

**jonathan.chaf** · 09/04/2018, 17h36

Bonjour,
J'ai créer un classeur excel avec une 15ene d'userform me permettant de gérer différentes liste de données (contact, relevé...) tout les userform et toutes les macro fonctionnent bien.
Sauf que... au bout d'un certain temps les userforms mettent de plus en plus de temps à s'ouvrir et à se charger et même une fois les listebox chargées ça rame férocement du coup je referme le classeur et le réouvre et comme par magie ce repart à vitesse normale mais seulement pour quelques minutes.

Alors je précise que ce n'est que les macro qui mettent plus de temps à s'exécuter et non pas excel en lui même.
Je peut travailler aussi longtemps que je veux sur excel mais des que j'utilise trop les userforms ceux ci font la tête.

C'est comme si la mémoire de vba se surchargait

En espérant vraiment que vous aller trouver la solution sinon j'aurai tout ce travail pour rien

**joe.levrai** · 09/04/2018, 19h50

Bonjour,

si tu penses que c'est "comme si la mémoire de vba se surchargait", je t'invite, dans chaque procédure, à décharger tes variables objets.

Egalement, limiter au maximum les variables publiques

Et, au possible, privilégier les Unload (et Reload quand y'a besoin) tes Userform, au lieu de les .Hide, afin de soulager la gestion des variables et contrôles

S'intéresser également aux potentielles formules excel (trop de formules, tformules complexes etc...), aux Mises En Formes conditionnelles.
Travailler en désactivant le recalcul automatique, le rafraichissement d'écran etc...

Bref, optimiser encore plus ta machinerie

**jonathan.chaf** · 18/04/2018, 09h31

voici un exemple d'une de mes macro.
Celle ci met de plus en plus de temps a s'actionner étant donner que les tableaux se remplissent de jour en jour. si vous pouviez me donnez des conseils pour l'améliorer.

C'est une macro qui lance un code pour afficher les résultat dans une listebox dans une feuille de calcul

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Option Explicit
 
 
Sub Lister()
 Dim no_ligne As Integer
 Dim no_ligne2 As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Id_R As Long
    Dim FrequenceR As Integer
    Dim Frequence As Integer
    Dim NomClient As String
    Application.ScreenUpdating = False
   Me.ListBox1.Clear
  Sheets("BD_Contrat").Select
    'les entrées commencent a la 2 ligne
    'no_ligne = ListBox2.ListIndex.adress
    'on chercvhe la derniere ligne de BD_Contrat
         no_ligne = Feuil7.Range("TBL_Contrat[[ID_Client]]").Column
         no_ligne = Feuil7.Columns(no_ligne).Find("*", , , , xlByColumns, xlPrevious).Row
  Sheets("BD_Releve").Select
    'les entrées commencent a la 2 ligne
    'no_ligne = ListBox2.ListIndex.adress
    'on chercvhe la derniere ligne de BD_Releve
         no_ligne2 = Feuil6.Range("TBL_Releve[[ID_Releve]]").Column
         no_ligne2 = Feuil6.Columns(no_ligne2).Find("*", , , , xlByColumns, xlPrevious).Row
 If no_ligne2 = 2 Then
 MsgBox "Pas de données enregistrées"
  Sheets("Acceuil").Select
 Application.ScreenUpdating = True
 Exit Sub
 End If
 
 'marque l'entête
  Me.ListBox1.AddItem "ID"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = "Nom Client"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = "Contrat"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = "Marque"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = "Modele"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = "Frequence"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = "Date dernier relevé"
 For i = 2 To no_ligne 'on passe les contrat 1 par 1 et on prend ID_Releve
    Sheets("BD_Contrat").Select
    Id_R = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[ID_Releve]]").Column)
    Frequence = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[Frequence_Releve]]").Column) * 30 'converti en jours
 
If Id_R <> 0 Then 'on ne prend pas ID = 0 car ID de base pour garder les formules dans le tableau si effacement
 
    Sheets("BD_Releve").Select
        For j = 2 To no_ligne2
        If Id_R = Feuil6.Cells(j, Feuil6.Range("TBL_Releve[[ID_Releve]]").Column) Then
            FrequenceR = Date - Feuil6.Cells(j, Feuil6.Range("TBL_Releve[[Date]]").Column) 'on test si la date du relevé n'est pas trop vielle
            If FrequenceR > Frequence Then
            Me.ListBox1.AddItem Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[ID_Client]]").Column)
    NomClient = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[ID_Client]]").Column) 'prend le code clients
    NomClient = Feuil4.Columns(Feuil4.Range("TBL_Clients[[ID_client]]").Column).Find(NomClient, LookAt:=xlWhole).Row 'regarde l'emplacement du code clients
    NomClient = Feuil4.Cells(NomClient, Feuil4.Range("TBL_Clients[[Nom Entreprise]]").Column) 'donne le nom du clients
 
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = NomClient
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[N_Contrat]]").Column)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[Marque]]").Column)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[Modele]]").Column)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Feuil7.Cells(i, Feuil7.Range("TBL_Contrat[[Frequence_Releve]]").Column) & " mois"
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Feuil6.Cells(j, Feuil6.Range("TBL_Releve[[Date]]").Column)
 
 
            Exit For
            End If
            Exit For
        End If
        Next j
 End If
 Next i
 Sheets("Acceuil").Select
 Application.ScreenUpdating = True
 
End Sub
 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Call Lister
Application.ScreenUpdating = True
End Sub