Re : Fonction sous total très lente dans une macro
Bonjour,
Merci pour ton message! C'est vrai que je n'ai pas donné beaucoup de détail ;-). En voici donc:
ma fonction récupère des données d'une BDD puis elle met en forme ces données.
Comme la mise à jour prend du temps j'ai ajouté de quoi tracer les temps d’exécution dans le code. Voici le résultat:
Lancement rafraichissement 9:50:03 AM
Fin rafraichissement 9:50:09 AM
Onglet Base de calculs 9:50:10 AM
Début du traitement du pb des dates 9:50:12 AM
Fin du traitement du pb des dates 9:50:16 AM
Fin du sous total ba client 9:52:00 AM
Fin de la mise en forme des ss totaux de la BA client 9:53:40 AM
Début de l'affichage niveau 2 9:53:42 AM
Fin de l'affichage niveau 2 9:55:24 AM
Fin du traitement de la BA client 9:55:24 AM
On voit que c'est le sous total, la mise en forme des lignes de sous totaux et l'affichage de ce sous total en niveau 2 qui prend beaucoup de temps.
Voici maintenant mon code (il n'est surement pas très optimisé...). Merci de ton aide!
Sub BOUTON_MAJ()
'---------------------------------------------------
'------ Déclaration des Variables ------------------
'---------------------------------------------------
Dim derlig As Integer
Dim derlig_CALCUL As Integer
Dim derlig_BA_CLT As Integer
Dim derlig_BA_BU As Integer
Dim dercel As Integer
Dim Feuille_Existe As Boolean
Dim nbligne As Integer
' Annulation des alertes d'Excel
Application.DisplayAlerts = False
Application.ScreenUpdating = False
' ---------------------------------------------------------
' ---- Mise à jour de l'onglet BASE et TABLEAU_DE_BORD ----
' ---------------------------------------------------------
Range("D6").Value = Date
Range("D7").Value = Time
Sheets("TABLEAU_DE_BORD").Range("C44").Value = "Lancement rafraichissement"
Sheets("TABLEAU_DE_BORD").Range("D44").Value = Time
Sheets("BASE").Range("A2").QueryTable.Refresh BackgroundQuery:=False
reponse = MsgBox("Rafraichissement des données en cours. Merci de patienter...", vbInformation, "Mise à jour des données")
Sheets("TABLEAU_DE_BORD").Range("C45").Value = "Fin rafraichissement"
Sheets("TABLEAU_DE_BORD").Range("D45").Value = Time
' Récupération du nombre de lignes dans une variable
derlig = Sheets("BASE").Range("A65536").End(xlUp).Row
' Mise en forme des colonnes
Sheets("BASE").Columns("L:O").Style = "Comma"
Sheets("BASE").Columns("P
").NumberFormat = "#,##0_ ;-#,##0 "
Sheets("BASE").Columns("Q:V").Style = "Comma"
Sheets("BASE").Columns("Z:AB").Style = "Comma"
Sheets("BASE").Columns("AA:AC").Style = "Comma"
Sheets("BASE").Columns("AE:AJ").Style = "Comma"
' Ajustement des colonnes
Sheets("BASE").Columns("A:AJ").EntireColumn.AutoFit
' Retour à la ligne et alignement vertical et horizontal centré de la première ligne
Sheets("BASE").Range("A1:AJ1").HorizontalAlignment = xlCenter
Sheets("BASE").Range("A1:AJ1").VerticalAlignment = xlCenter
Sheets("BASE").Columns("C:K").ColumnWidth = 10
Sheets("BASE").Columns("G:G").ColumnWidth = 15
' ----------------------------------------------------------------------------
' ------- Mise à jour de l'onglet BASE_CALCUL sans opérations INTERCO --------
' ----------------------------------------------------------------------------
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C46").Value = "Onglet Base de calculs"
Sheets("TABLEAU_DE_BORD").Range("D46").Value = Time
' On supprime tout ce qu'il y a dans l'onglet
Sheets("BASE_CALCUL").Cells.Delete Shift:=xlUp
Sheets("BASE").Range("A1:AJ" & derlig).AutoFilter Field:=3, Criteria1:="<>OI", _
Operator:=xlAnd
'--- Copie de la sélection dans l'onglet BASE_CALCUL
Sheets("BASE").Range("A1:AJ" & derlig).Copy _
Destination:=Sheets("BASE_CALCUL").Range("A1")
' Récupération du nombre de lignes de l'onglet CALCUL dans une variable
derlig_CALCUL = Sheets("BASE_CALCUL").Range("A65536").End(xlUp).Row
'------------------------------------------
'Traitement du problème du format des dates
'------------------------------------------
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C47").Value = "Début du traitement du pb des dates"
Sheets("TABLEAU_DE_BORD").Range("D47").Value = Time
Sheets("BASE_CALCUL").Columns("K").Insert Shift:=xlToLeft
Sheets("BASE_CALCUL").Columns("M").Insert Shift:=xlToLeft
'Copie de la colonne DATE_DOC dans la colonne K
Sheets("BASE_CALCUL").Range("K2").FormulaR1C1 = "=DATEVALUE(RC[-1])"
Sheets("BASE_CALCUL").Range("K2:K" & derlig_CALCUL).FillDown
'Copie de la colonne DATE_ECHEANCE dans la colonne M
Sheets("BASE_CALCUL").Range("M2").FormulaR1C1 = "=DATEVALUE(RC[-1])"
Sheets("BASE_CALCUL").Range("M2:M" & derlig_CALCUL).FillDown
'Recopie des valeurs des nouvelles colonnes dans les colonnes d'origine
Sheets("BASE_CALCUL").Range("J1").Copy _
Destination:=Sheets("BASE_CALCUL").Range("K1")
Sheets("BASE_CALCUL").Range("L1").Copy _
Destination:=Sheets("BASE_CALCUL").Range("M1")
Sheets("BASE_CALCUL").Range("K1:K" & derlig_CALCUL).Copy
Sheets("BASE_CALCUL").Range("J1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Sheets("BASE_CALCUL").Range("M1:M" & derlig_CALCUL).Copy
Sheets("BASE_CALCUL").Range("L1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Sheets("BASE_CALCUL").Columns("K:K").Delete Shift:=xlToLeft
Sheets("BASE_CALCUL").Columns("L:L").Delete Shift:=xlToLeft
Sheets("BASE_CALCUL").Columns("J:J").NumberFormat = "m/d/yyyy"
Sheets("BASE_CALCUL").Columns("K:K").NumberFormat = "m/d/yyyy"
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C48").Value = "Fin du traitement du pb des dates"
Sheets("TABLEAU_DE_BORD").Range("D48").Value = Time
' ----------------------------------------------------------------
' ------- Mise à jour de l'onglet BALANCE_AGEE_PAR_CLIENT --------
' -----------------------------------------------------------------
' On supprime tout ce qu'il y a dans l'onglet
Sheets("BALANCE_AGEE_PAR_CLIENT").Cells.Delete Shift:=xlUp
Sheets("BASE_CALCUL").Range("A1:Z" & derlig_CALCUL).Copy _
Destination:=Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A1")
'Permet de figer les colonnes et les lignes
Sheets("BALANCE_AGEE_PAR_CLIENT").Activate
ActiveWindow.SplitRow = 1
ActiveWindow.SplitColumn = 1
ActiveWindow.FreezePanes = True
' Sous totaux par rapport aux comptes clients
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A1:Z" & derlig_CALCUL).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(15, 17, 18, 19 _
, 20, 21, 22), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C49").Value = "Fin du sous total ba client"
Sheets("TABLEAU_DE_BORD").Range("D49").Value = Time
derlig_BA_CLT = Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A65536").End(xlUp).Row
' Mise en forme de la première ligne
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A1:Z1").Interior.ColorIndex = 43
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("R1:V1").Interior.ColorIndex = 3
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("R1:V1").Font.ColorIndex = 2
' Mise en forme des lignes de sous totaux
For i = 1 To (derlig_BA_CLT + 1)
If (Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i) = "Total" Or Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i) = "Total général") Then
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i & ":Z" & i).Interior.ColorIndex = 43
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("R" & i & ":V" & i).Interior.ColorIndex = 3
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("R" & i & ":V" & i).Font.ColorIndex = 2
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i & ":Z" & i).Font.Bold = True
Else
If Left(Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i).Value, 5) = "Total" Then
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("B" & i).Value = Sheets("BALANCE_AGEE_PAR_CLIENT").Range("B" & i - 1).Value
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i & ":Z" & i).Interior.ColorIndex = 15
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i & ":Z" & i).Font.Bold = True
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A" & i & ":Z" & i).Borders(xlEdgeBottom).LineStyle = xlContinuous
End If
End If
Next i
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C50").Value = "Fin de la mise en forme des ss totaux de la BA client"
Sheets("TABLEAU_DE_BORD").Range("D50").Value = Time
' Ajustement des colonnes
Sheets("BALANCE_AGEE_PAR_CLIENT").Columns("A:Z").EntireColumn.AutoFit
' Regroupement des sous totaux au niveau 2
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C51").Value = "Début de l'affichage niveau 2"
Sheets("TABLEAU_DE_BORD").Range("D51").Value = Time
Sheets("BALANCE_AGEE_PAR_CLIENT").Outline.ShowLevels RowLevels:=2
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C52").Value = "Fin de l'affichage niveau 2"
Sheets("TABLEAU_DE_BORD").Range("D52").Value = Time
' On masque les colonnes qui MT_RECU et MT_TX_CHANGE et les colonnes Date Comptable et date de document
Sheets("BALANCE_AGEE_PAR_CLIENT").Columns("H:I").EntireColumn.Hidden = True
Sheets("BALANCE_AGEE_PAR_CLIENT").Columns("L:N").EntireColumn.Hidden = True
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A1:Z1").NumberFormat = "General"
Sheets("BALANCE_AGEE_PAR_CLIENT").Range("A1:Z1").Font.Size = 8
' ******* Suivi du temps d'execution *******
Sheets("TABLEAU_DE_BORD").Range("C53").Value = "Fin du traitement de la BA client"
Sheets("TABLEAU_DE_BORD").Range("D53").Value = Time
Exit Sub
