Optimisation d'une macro

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.

Ps: jai reçu le conseil suivant, mais je ne sais pas comment le mettre en application: "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.

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."

Mais je ne sais pas l'appliquer

Private Sub CmdExportPDF_Click()
Dim Chemin$, Fiche$, NomFiche$
Dim SheetArray() As Variant
Dim I&, Indx&
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fiche = "Liasses Syscohada"
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

Bonjour,

Déjà si je m'en tiens à la procédure de clôture de votre UserForm, je note des incohérences.

1- la dénomination de votre variable "cellules" est illogique, elle devrait être "cellule" car "In Sheets(N).UsedRange" représente par défaut "In Sheets(N).UsedRange.Cells"

Vous examinez donc chaque cellule utilisée de toutes vos feuilles, voilà qui prend déjà un certain temps.

2- Cet examen est-il vraiment nécessaire pour réafficher les lignes masquées ?

3- Cette instruction "Sheets(N).Cells.EntireRow.Hidden = False" est sans rapport avec la cellule fournie par la boucle

4- Je ne vois pas dans votre cas l'intérêt de cette procédure événementielle "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)" car vous n'utilisez ni Cancel, ni CloseMode. La procédure évenementielle "Private Sub UserForm_terminate" est suffisante.

ci-dessous code plus rapide pour réafficher vos lignes masquées

Private Sub UserForm_terminate()
    Dim feuille As Worksheet

    ' Réouverture des lignes masqu?es
    For Each feuille In Worksheets
        feuille.UsedRange.Rows.Hidden = False
    Next feuille
End Sub

Bonjour,

Je complète ma réponse pour l'optimisation de l'affichage du formulaire.

Pour réduire le temps de traitement, il faut utiliser un tableau dynamique.

ci-dessous proposition de modification de code

Private Sub UserForm_Activate()
    Dim feuille As Worksheet
    Dim c1 As Integer, c2 As Integer, f As Integer, i As Long, j As Long
    Dim noms_feuille(), tableau(), lignes_à_masquer()
    Const rech1 As String = "Roc", rech2 As String = "Cor"

    Application.ScreenUpdating = False
    noms_feuille = Array(): f = 0
    For Each feuille In Worksheets
        ' détermination des lignes à masquer
        c1 = 0: c2 = 0: j = 0: lignes_à_masquer = Array()
        With feuille
            On Error Resume Next
            c1 = .UsedRange.Find(rech1).Column - .UsedRange.Column + 1
            c2 = .UsedRange.Find(rech2).Column - .UsedRange.Column + 1
            If c1 <> 0 And c2 <> 0 Then
                ReDim Preserve noms_feuille(f): noms_feuille(f) = feuille.Name: f = f + 1
                tableau = .UsedRange.Value
                For i = 1 To UBound(tableau)
                    If tableau(i, c1) = 0 And tableau(i, c2) = 0 Then
                        ligne = i + .UsedRange.Row - 1
                        ReDim Preserve lignes_à_masquer(j): lignes_à_masquer(j) = ligne: j = j + 1
                    End If
                Next i

                ' masquage des lignes à zéro
                For i = 0 To UBound(lignes_à_masquer)
                    .Rows(lignes_à_masquer(i)).Hidden = True
                Next i
            End If
        End With
    Next feuille

    ' chargement listbox1
    If UBound(noms_feuille) = 0 Then ListBox1.AddItem noms_feuille(0)
    If UBound(noms_feuille) > 0 Then ListBox1.List = noms_feuille
End Sub

Edit: Ajout optimisation du chargement de la ListBox

Vraiment je vous remercie pour le coup de pouce

Je commençais par désespérer. Je vais mettre le code et vous revenir

Mais je voudrais déjà vous faire part d’un soucis c’est que mes tableaux commencent à partir de la ligne 12 et qu’avant il y a plusieurs cellules non vide

On m’a expliqué que ça amenait ma feuille originale à ne pas détecter les colonnes et donc à ne pas masquer les lignes .. Peznsez vous qu’avec la méthode on ait pas besoin de signifier à la macro’ que le tableau commençait à partir d’une certaines ligne

relmo a écrit :

Mais je voudrais déjà vous faire part d’un soucis c’est que mes tableaux commencent à partir de la ligne 12 et qu’avant il y a plusieurs cellules non vide

Cela n'amène aucun changement pour la détection des colonnes puisqu'elles le sont via deux Find. Cependant des lignes supplémentaires pourront être masquées si aucune valeur n'existe dans ces colonnes au-dessus du tableau. A voir si cela pose problème.

NB: Je viens de rajouter l'optimisation du chargement de la ListBox car avec 70 feuilles, la méthode .AddItem peut prendre du temps.

Voir code mofifié ci-dessus.

Idéalement il faudrait pas que les lignes avant le tableau soient masqué.. uniquement les lignes du tableau dont les colonnes roc et cor contiennent simultanément 0

thev a écrit :

ci-dessous code plus rapide pour réafficher vos lignes masquées

Désolé de ne répondre que maintenant. J'ai éssayé cette macro, mais elle me renvoie une Alerte "impossible de définir la propriété Hidden de la classe Range

relmo a écrit :

J'ai essayé cette macro, mais elle me renvoie une Alerte "impossible de définir la propriété Hidden de la classe Range

Si tu as ce message, c'est qu'une ou plusieurs de tes feuilles sont protégées.

En effet une feuille était protégée par MDP, mais je viens de supprimer pourtant c'est tjrs pareil

Tu rajoutes un select dans la macro et tu sauras sur quelle feuille ça bloque

Private Sub UserForm_terminate()

    Dim feuille As Worksheet

    ' Réouverture des lignes masquées
    For Each feuille In Worksheets
        feuille.Select
        feuille.UsedRange.Rows.Hidden = False
    Next feuille
End Sub

Cooool

Merci Thev! c'est réglé