XL 2013 Optimisation d'une macro

momo

XLDnaute Occasionnel
Bonjour à tous

J'ai cette macro qui me permet de faire un export sous PDF de plusieurs onglets au choix avec Masquage de lignes sous condition (que le les valeurs de deux colonnes comportent simultanément 0)

La macro fonction bien à condition d'avoir un petit fichier et de petits tableaux de quelques lignes

Par contre lorsque je l'intègre à un fichier de 70 Onglets avec des tableaux très longs, elle rame, juste pour lancer le Userform, au bout de 30 min elle n'y arrive pas

Je voudrais vos conseils pour arriver à l'optimiser.

VB:
Private Sub CmdExportPDF_Click()
Dim Chemin$, Fiche$, NomFiche$
Dim SheetArray() As Variant
Dim I&, Indx&
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fiche = "Test"
Indx = 0
    For I = 0 To LbFeuilles.ListCount - 1
        If LbFeuilles.Selected(I) Then
            ReDim Preserve SheetArray(Indx)
            SheetArray(Indx) = LbFeuilles.List(I)
            Indx = Indx + 1
        End If
    Next I
    If Indx > 0 Then
      Application.ScreenUpdating = False
        Sheets(SheetArray()).Select
        NomFiche = Chemin & Fiche
           ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
              Filename:=NomFiche, _
              Quality:=xlQualityMinimum, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False
    End If
Erase SheetArray
Feuil1.Select
    Unload Me
Application.Goto [A1], True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim Cellules As Range
    For N = 1 To Sheets.Count
        For Each Cellules In Sheets(N).UsedRange
            If Cellules = "Année N" And Cellules.Offset(0, 1) = "Année N-1" Then
                ' Réouverture des lignes masquées
                Sheets(N).Cells.EntireRow.Hidden = False
            End If
        Next
    Next N
End Sub
 

Fichiers joints

Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour.
Chargez et déchargez vos tableaux en une seule instruction, car 10000 accès à une seule cellule dure pratiquement 10000 fois un seul accès à 10000 cellules.
La propriété Value d'un objet Range de plusieurs cellules contigües est un Variant contenant directement un tableau 2D de Variant. Il suffit de faire des affectations dans les deux sens avec des variable tableaux. (dynamique, au moins en entrée)
La raison en est qu'Excel passe beaucoup plus de temps, et ce à chaque invocation d'une méthode Cells ou Range, à retrouver la localisation en mémoire dans les structures présentes l'emplacement des données de l'objet range de l'objet Worksheet représentant la feuille concernée dans l'objet Workbook représentant le classeur concerné, qu'à transférer les valeurs. Donc: toujours grouper à mort les requêtes à Excel pour en faire le moins souvent possible. Si possible un seul TDon = FeuilX.UsedRange.Value au début et un seul FeuilY.[A1].Resize(LMax,CMax).Value = TRésu à la fin.
 
Dernière édition:

momo

XLDnaute Occasionnel
Bonjour.
Chargez et déchargez vos tableaux en une seule instruction, car 10000 accès à une seule cellule dure pratiquement 10000 fois un seul accès à 10000 cellules.
La propriété Value d'un objet Range de plusieurs cellules contigües est un Variant contenant directement un tableau 2D de Variant. Il suffit de faire des affectations dans les deux sens avec des variable tableaux. (dynamique, au moins en entrée)
Merci Dranreb pour votre réponse

Mais n'étant pas un grand expert VBA, je ne vois pas trop comment faire pour mettre en application ton conseil

Pourriez vous me donner un petit coup de pouce dans ce sens?
 

Dranreb

XLDnaute Barbatruc
Non, je n'ai pas de classeur ouvert actuellement où je pourrais écrire quelque chose qui illustre ce que j'ai dit et le tester.
 

momo

XLDnaute Occasionnel
Non, je n'ai pas de classeur ouvert actuellement où je pourrais écrire quelque chose qui illustre ce que j'ai dit et le tester.
Ok d'accord, je vais peut-etre patienter pour un éventuel retour de votre part.. Parcce que je suis vraiment largué sur ce coup
 

Dranreb

XLDnaute Barbatruc
N'attendez pas: Faites le vous même comme je dis de le faire sur votre classeur que vous gardez pour vous au lieu d'en l'avoir téléversé une version sans données confidentielles.
 

momo

XLDnaute Occasionnel
N'attendez pas: Faites le vous même comme je dis de le faire sur votre classeur que vous gardez pour vous au lieu d'en l'avoir téléversé une version sans données confidentielles.
Ok je vais essayer en suivant vos conseils.
J'ai suivi votre conseil, j'ai mis un fichier test.
 

momo

XLDnaute Occasionnel
TDon = FeuilX.UsedRange.Value au début et un seul FeuilY.[A1].Resize(LMax,CMax).Value = TRésu à la fin.
J'ai essayé d'intégrer la formule en début et en fin comme vous l'avez préconisé, j'ai des messages d'erreur de "Variable non définie"
 

Dranreb

XLDnaute Barbatruc
Ok j'ai compris trop tard avant d'avoir vu votre message et donc supprimé le mien.
Pas évident de gagner grand chose au lancement de l'UserForm, mais ceci devrait aller un peu mieux :
VB:
Private Sub UserForm_Activate()
Dim Wsh As Worksheet, RngDon As Range, T(), L As Long, C As Long, RngLig As Range, RngMsk As Range
For Each Wsh In ThisWorkbook.Worksheets
   Set RngDon = Wsh.UsedRange: If RngDon.Rows.Count = 1 And RngDon.Columns.Count _
      = 1 Then ReDim T(1 To 1, 1 To 1): T(1, 1) = RngDon.Value Else T = RngDon.Value
   For C = 1 To UBound(T, 2) - 1
      If T(1, C) = "Roc" And T(1, C + 1) = "Cor" Then Exit For
         Next C
   If C < UBound(T, 2) Then
      Set RngMsk = Nothing
      For L = 2 To UBound(T, 1)
         If T(L, C) = 0 And T(L, C + 1) = 0 Then
            Set RngLig = RngDon.Rows(L).EntireRow
            If RngMsk Is Nothing Then Set RngMsk = RngLig Else Set RngMsk = Union(RngMsk, RngLig)
            End If: Next L
      If Not RngMsk Is Nothing Then RngMsk.EntireRow.Hidden = True
      End If
   ListBox1.AddItem Wsh.Name
   Next Wsh
End Sub
 

mapomme

XLDnaute Barbatruc
Bonjour @momo, @Dranreb,

Pour ce que j'en ai compris, une piste dans le fichier joint. Le code est dans Module1.La macro principale est Sub MasquerRocCor00(xw As Worksheet).

Il faut d'abord cliquer sur le bouton rose 'Initialisation' pour placer dans les feuilles un tableau de type "Roc/Cor" d’environ 5 000 lignes chacun.

Il me semble que c'est assez rapide (si ça répond effectivement au problème de momo)
 

Fichiers joints

momo

XLDnaute Occasionnel
Bonjour @momo, @Dranreb,

Pour ce que j'en ai compris, une piste dans le fichier joint. Le code est dans Module1.La macro principale est Sub MasquerRocCor00(xw As Worksheet).

Il faut d'abord cliquer sur le bouton rose 'Initialisation' pour placer dans les feuilles un tableau de type "Roc/Cor" d’environ 5 000 lignes chacun.

Il me semble que c'est assez rapide (si ça répond effectivement au problème de momo)
Bonjour Mapommme

Ca ne répond pas trop à l'objectif visé, puisque le but est d'exporter sur PDF chaque onglet, il y a une colonne après description avant de voir la colonne Rocet Coret pour certains la colonne Roc vient
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Et avec mon code l'affichage de l'UserForm est plus rapide s'il y a beaucoup de feuilles avec des tableaux plus gros ?
 

mapomme

XLDnaute Barbatruc
Bonjour @Dranreb et bonne année :)

Bonjour.
Et avec mon code l'affichage de l'UserForm est plus rapide s'il y a beaucoup de feuilles avec des tableaux plus gros ?
mapomme, elle ( la pomme car sinon c'est il ;)) n'a pas testé et ne testera pas. Pour moi, c'était juste une piste avec un filtre avancé pour voir ce que ça pouvait donner en répondant au souci de momo au niveau du délai.
 

momo

XLDnaute Occasionnel
Ok j'ai compris trop tard avant d'avoir vu votre message et donc supprimé le mien.
Pas évident de gagner grand chose au lancement de l'UserForm, mais ceci devrait aller un peu mieux :
VB:
Private Sub UserForm_Activate()
Dim Wsh As Worksheet, RngDon As Range, T(), L As Long, C As Long, RngLig As Range, RngMsk As Range
For Each Wsh In ThisWorkbook.Worksheets
   Set RngDon = Wsh.UsedRange: If RngDon.Rows.Count = 1 And RngDon.Columns.Count _
      = 1 Then ReDim T(1 To 1, 1 To 1): T(1, 1) = RngDon.Value Else T = RngDon.Value
   For C = 1 To UBound(T, 2) - 1
      If T(1, C) = "Roc" And T(1, C + 1) = "Cor" Then Exit For
         Next C
   If C < UBound(T, 2) Then
      Set RngMsk = Nothing
      For L = 2 To UBound(T, 1)
         If T(L, C) = 0 And T(L, C + 1) = 0 Then
            Set RngLig = RngDon.Rows(L).EntireRow
            If RngMsk Is Nothing Then Set RngMsk = RngLig Else Set RngMsk = Union(RngMsk, RngLig)
            End If: Next L
      If Not RngMsk Is Nothing Then RngMsk.EntireRow.Hidden = True
      End If
   ListBox1.AddItem Wsh.Name
   Next Wsh
End Sub
Bonjour Dranreb

Lorsque j'intègre la macro à mon fichier , il renvoie un message d'erreur et lorsque j'essaie de désactiver la macro à cause de laquelle l'erreur survient l'export ne fait pas le masquage des lignes à 0

Par contre le gain de temps recherché est réglée

Je vous joins le fichier
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Déclarez toutes vos variables, c'est une bonne habitude.
Avec Option Explicit en tête du module la mise au point est plus facile: Il ne tente pas d'exécution tant que des déclarations manquent et les message de compilation sont plus clairs que les message d'exécution résultant des mêmes oublis.
 

momo

XLDnaute Occasionnel
Déclarez toutes vos variables, c'est une bonne habitude.
Avec Option Explicit en tête du module la mise au point est plus facile: Il ne tente pas d'exécution tant que des déclarations manquent et les message de compilation sont plus clairs que les message d'exécution résultant des mêmes oublis.
C'est fait,

Mais le Masquage des ligne à 0 ne se fait toujours pas lors de l'export en PDF
 

Fichiers joints

momo

XLDnaute Occasionnel
C'est probablement parce que vos titres ne sont plus toujours en ligne 1 des UsedRange.
Okay.. les titres sur les lignes de mon fichier se truvent tjrs en ligne 12.

Comment je fais donc pour l'indiquer à la macro. qu'est ce qu'il faut que je change
 

Discussions similaires


Haut Bas