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
 

Pièces jointes

  • Imprimer_V2 (2).xls
    101 KB · Affichages: 27
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
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
Supporter XLD
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)
 

Pièces jointes

  • momo- Imprimer_V2- 001.xls
    484 KB · Affichages: 26

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
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • Test.xlsm
    167.4 KB · Affichages: 15

Discussions similaires