Macro qui consomme trop de ressource
Bonjour,
j'ai un fichier qui est composé de plusieurs tableaux (mode tableau) dans lesquels se déroulent des étapes de calculs.
Au départ, j'injecte les données dans un onglet base de données, ensuite je lance la macro pour entrer le nombre de ligne que j'ai injectée.
cela a pour conséquence de redimensionner l'ensemble des autres tableaux à la même dimension avec tout ou partie des données de la base en fonction des calculs.
Mon problème est que tout va bien sous conditions que je n'injecte pas plus de 10000-15000 lignes en fonction de la puissance du PC.
Ensuite ça bug en me disant pas assez de mémoire pour le traitement ):
Bien que Windows soit en 64 mon Excel n'est qu'en 32 et ne peut donc à priori pas utiliser plus de 4GO de RAM (voir un peu moins) alors que j'en ai 8.
Mais je me suis aperçu aussi que si je refermai Excel et le réouvrai ça marche mieux pour fair deux fichiers à la suite.
Je me demandais donc si une optimisation de la macro par vidage de cache ou d'autres trucs auquel je ne pense pas pourrait peut-être régler mon problème plutôt que d'investir dans Excel 64 (sans certitude que ça marchera mieux pour autant)
Merci de jeter un oeuil (ou les deux) pour me dire ce que vous en pensez
Private Sub BoutonMàJDonnées_Click()
Application.ScreenUpdating = False
Dim NbLignes As Long
'Entrée manuelle du nouveau nombre de lignes que doit posséder l'onglet "Base de données"
NbLignes = Application.InputBox(prompt:="Entrez le nombre de NNO.", Type:=1)
If NbLignes > 0 Then
NbLignes = NbLignes + 3
'Mise à jour du nombre de lignes du tableau de l'onglet "Base de données"
Sheets("Base de données").Select
ActiveSheet.ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 183))
'Mise à jour du nombre de lignes du tableau de l'onglet "M_Segmenter"
Sheets("M_Segmenter").Select
ActiveSheet.ListObjects("TableauMSEGMENTER").Resize Range(Cells(3, 1), Cells(NbLignes, 17))
'Mise à jour du nombre de lignes du tableau de l'onglet "M_Prévoir"
Sheets("M_Prévoir").Select
ActiveSheet.ListObjects("TableauMPREVOIR").Resize Range(Cells(3, 1), Cells(NbLignes, 35))
'Mise à jour du nombre de lignes du tableau de l'onglet "M_Sécuriser"
Sheets("M_Sécuriser").Select
ActiveSheet.ListObjects("TableauMSECURISER").Resize Range(Cells(3, 1), Cells(NbLignes, 16))
'Mise à jour du nombre de lignes du tableau de l'onglet "M_Planifier"
Sheets("M_Planifier").Select
ActiveSheet.ListObjects("TableauMPLANIFIER").Resize Range(Cells(3, 1), Cells(NbLignes, 170))
'Mise à jour du nombre de lignes du tableau de l'onglet "R_Planif"
Sheets("R_Planif").Select
ActiveSheet.ListObjects("TableauRPLANIF").Resize Range(Cells(3, 10), Cells(NbLignes, 35))
'Sélection de l'onglet "R_Erosion et Flux financier" afin qu'il apparaisse à l'écran à la fin de cette macro
Sheets("R_Erosion et Flux financier").Cells.EntireColumn.AutoFit
Sheets("R_Erosion et Flux financier").Select
'Dans le cas où l'on diminue le nombre de lignes dans l'onglet "Base de données" :
'On nettoie les lignes "en surplus" des autres onglets
Sheets("M_Segmenter").Activate
Dim MSegDernLigne As Long
MSegDernLigne = Sheets("M_Segmenter").Range("A1048576").End(xlUp).Row
If MSegDernLigne > NbLignes Then
Sheets("M_Segmenter").Rows(NbLignes + 1 & ":" & MSegDernLigne).Select
Selection.ClearContents
End If
Sheets("M_Prévoir").Activate
Dim MPreDernLigne As Long
MPreDernLigne = Sheets("M_Prévoir").Range("A1048576").End(xlUp).Row
If MPreDernLigne > NbLignes Then
Sheets("M_Prévoir").Rows(NbLignes + 1 & ":" & MPreDernLigne).Select
Selection.ClearContents
End If
Sheets("M_Sécuriser").Activate
Dim MSecDernLigne As Long
MSecDernLigne = Sheets("M_Sécuriser").Range("A1048576").End(xlUp).Row
If MSecDernLigne > NbLignes Then
Sheets("M_Sécuriser").Rows(NbLignes + 1 & ":" & MSecDernLigne).Select
Selection.ClearContents
End If
Sheets("M_Planifier").Activate
Dim MPlaDernLigne As Long
MPlaDernLigne = Sheets("M_Planifier").Range("A1048576").End(xlUp).Row
If MPlaDernLigne > NbLignes Then
Sheets("M_Planifier").Rows(NbLignes + 1 & ":" & MPlaDernLigne).Select
Selection.ClearContents
End If
Sheets("R_Planif").Activate
Dim RPlnDernLigne As Long
RPlnDernLigne = Sheets("R_Planif").Range("J1048576").End(xlUp).Row
If RPlnDernLigne > NbLignes Then
If NbLignes > 18 Then
Sheets("R_Planif").Rows(NbLignes + 1 & ":" & RPlnDernLigne).Select
Selection.ClearContents
Else
If RPlnDernLigne > 18 Then
Sheets("R_Planif").Rows(19 & ":" & RPlnDernLigne).Select
Selection.ClearContents
End If
For a = NbLignes + 1 To 18
For b = 10 To 35
Sheets("R_Planif").Cells(a, b).ClearContents
Next
Next
End If
End If
'Sélection de l'onglet "R_Erosion et Flux financier" afin qu'il apparaisse à l'écran à la fin de cette macro
Sheets("R_Erosion et Flux financier").Cells.EntireColumn.AutoFit
Sheets("R_Erosion et Flux financier").Select
End If
Application.ScreenUpdating = False
End SubHello aokiba,
Toujours compliqué de voir les lenteurs de PC via le forum.
Sur ta macro je sais pas ce qu'elle fait, mais tu dois absolument limiter l'usage des "select" et activesheet.
Essaye de passer par des variables. Je ne connais pas ton niveau de programmation mais les variables et utilisation des objets excel sont vraiment un + pour accélérer le code.
exemple:
sheets("Base de données").Select
ActiveSheet.ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 183))
'ecriture du code sans select
dim ws as worksheet
set ws = sheets("Base de données")
ws.ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 183))Bonjour,
merci, je ne connaissais pas. J'ai essayé mais ça bug dés le départ sur la ligne en bleu? Qu'est ce que je ne fais pas de bien?
Dim NbLignes As Long
Dim bdd As Worksheet
Dim segmenter As Worksheet
Dim prévoir As Worksheet
Dim sécuriser As Worksheet
Dim planifier As Worksheet
Dim planif As Worksheet
Dim erosion As Worksheet
'Entrée manuelle du nouveau nombre de lignes que doit posséder l'onglet "Base de données"
NbLignes = Application.InputBox(prompt:="Entrez le nombre de NNO.", Type:=1)
If NbLignes > 0 Then
NbLignes = NbLignes + 3
'Mise à jour du nombre de lignes du tableau de l'onglet "Base de données"
'Sheets("Base de données").Select
'ActiveSheet.ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 183))
Set bdd = Sheets("Base de données")
[color=#0040FF] ws.ListObjects("TableauBASEDEDONNEES").Resize Range(Cells(3, 1), Cells(NbLignes, 183))[/color]
'Mise à jour du nombre de lignes du tableau de l'onglet "M_Segmenter"
'Sheets("M_Segmenter").Select
'ActiveSheet.ListObjects("TableauMSEGMENTER").Resize Range(Cells(3, 1), Cells(NbLignes, 17))
Set segmenter = Sheets("M_Segmenter")
ws.ListObjects("TableauMSEGMENTER").Resize Range(Cells(3, 1), Cells(NbLignes, 17))
'Mise à jour du nombre de lignes du tableau de l'onglet "M_Prévoir"
'Sheets("M_Prévoir").Select
'ActiveSheet.ListObjects("TableauMPREVOIR").Resize Range(Cells(3, 1), Cells(NbLignes, 35))Bonjour,
au temps pour moi, je n'avais pas modifier toutes mes variables dans la précipitation.
La macro fonctionne donc plus rapidement qu'avant mais excel me jette quand même à l'injection de plus de 50000 lignes.
En plus de virer les .select, y a t-il d'autres astuces pour libérer de la mémoire entre chaque étape de redimensionnement de mes tableaux ?
merci