Masquer une ligne sous deux conditions

Question

Bonjour,

J'utilise la macro suivante sous Excel 2003 afin de masquer des lignes suivant 2 conditions.
Elle fonctionne mais met beaucoup trop de temps !
Auriez-vous des idées pour l'améliorer afin que ça aille plus vite.

Merci d'avance.

Sub Masquer ()

' masque les lignes inutiles

Dim MyPlage As Range
Dim Plage As Range
Dim derlign As Integer
Dim y As Integer
Dim cell As Range
derlign = Sheets(2).Range("P2").Value
y = Sheets(2).Range("O2").Value

With Worksheets(y)

Set MyPlage = Sheets(y).Range("A4:A" & derlign)
For Each cell In MyPlage
If cell.Value = Sheets(2).Range("M2").Value Then
cell.EntireRow.Hidden = False
ElseIf cell.Value <> Sheets(2).Range("M2").Value Then
cell.EntireRow.Hidden = True
End If
Next

Set MyPlage = Sheets(y).Range("E4:E" & derlign)
For Each cell In MyPlage
If cell.Value <> Sheets(2).Range("R2").Value Then
cell.EntireRow.Hidden = True
End If
Next

End With

End Sub

Afficher la suite

cousinhub29 · Answer

Bonjour,

Essaie ainsi :

Sub Masquer()
Dim MyPlage As Range, Cell As Range
Dim DerLign As Long
With Worksheets(Sheets(2).Range("O2").Value)
    DerLign = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Set MyPlage = .Range("A4:A" & DerLign)
    .Cells.EntireRow.Hidden = False
    For Each Cell In MyPlage
        Cell.EntireRow.Hidden = Cell.Value <> Sheets(2).Range("M2").Value
        Cell.EntireRow.Hidden = Cell.Offset(, 4).Value <> Sheets(2).Range("R2").Value
    Next
End With
End Sub

Peut-être plus rapide (je ne fais qu'une boucle....)

A voir

cousinhub29 · Answer

Bonjour,

Et ainsi, est-ce que cela fait gagner un peu de temps?

Sub Masquer2()
Dim MyPlage As Range, Cell As Range
Dim DerLign As Long
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    With Worksheets(Sheets(2).Range("O2").Value)
        DerLign = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Set MyPlage = .Range("A4:A" & DerLign)
        .Cells.EntireRow.Hidden = False
        For Each Cell In MyPlage
            Cell.EntireRow.Hidden = Cell.Value <> Sheets(2).Range("M2").Value
            Cell.EntireRow.Hidden = Cell.Offset(, 4).Value <> Sheets(2).Range("R2").Value
        Next
    End With
    .Calculation = xlCalculationAutomatic
End With
End Sub

Bonne nuit

cousinhub29 · Answer

Bonjour,

Avec mon précédent code, cela masquait-il bien?

C'est exactement le même....

A la rigueur, rajoute cette ligne, en fin de code :

    End With
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True  ' <---- celle-ci
End With
End Sub

Utilisateur anonyme · Answer

Bonjour,

Merci de m'aider.
Je vous envois ci-joint un exemple de mon fichier.

http://www.cijoint.fr/cjlink.php?file=cj201009/cijgBr6cSo.xls

L'utilisateur doit sélectionner un élément en D18 et en D20 sélectionner «Envoyer Une Demande de Correction» ce qui ouvre un formulaire.

Pour le test je choisis donc « CC » et « Envoyer Une Demande de Correction » ensuite dans le formulaire il doit sélectionner un trimestre et un service ; la macro doit donc masquer toutes les lignes ne correspondant pas à ce critère.
Ma macro est dans le module1, elle est appelée par la macro de l'UserForm7.

Laure

cousinhub29 · Answer

Re-,

Eh ben, pour une usine à gaz....

En mode pas-à-pas, j'ai réussi à faire fonctionner un code, qui balayait toutes les cellules de la colonne A, mais en automatique, cela ne fonctionnait pas nominalement...

Aussi je te propose ce code, qui fonctionne, et qui utilise les filtres automatiques...

Le code met environ 3.5 secondes pour masquer les lignes qui ne correspondent pas aux critères...

Sub Masquer3()
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    With Worksheets(Sheets(2).Range("O2").Value)
        With .Range("A3:E3")
            .AutoFilter Field:=1, Criteria1:=Sheets(2).Range("M2").Value
            .AutoFilter Field:=5, Criteria1:=Sheets(2).Range("R2").Value
        End With
    End With
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub


Tu remplaces ta macro "Masquer_IT_IP" par celle-là (n'oublie pas de la renommer, ou de changer la commande dans l'usf7

Bon courage

PS, pour tout ré afficher, tu fais Données/Filtre/Afficher tout

cousinhub29 · Answer

Re-,

J'ai fait plusieurs essais, et pas de soucis...

Que mets-tu comme conditions, dans la page "Menu"?

@ te relire

cousinhub29 · Answer

Re-,

Ton fichier, vu son poids, donne de gros soucis de fiabilité....

De plus, avec tous les codes, les usf.....

Pour la feuille CC, cela fonctionne bien, j'ai voulu modifier pour la DD, ça n'a pas voulu, je l'ai enregistré, fermé Excel, redémarré, et là, ça a fonctionné....

A mon avis, tu risques d'avoir des soucis à l'avenir avec ce fichier....

J'ai un "peu" allégé ton fichier, avec un code de nettoyage, il ne fait plus que 1.5 Mo

http://www.cijoint.fr/cjlink.php?file=cj201009/cijupQuscF.zip

Bon courage

Le Pingou · Answer

Bonjour,
Merci pour vos explications.
Je viens de constater qu'il y a un probléme avec vos procédures qui tournent en boucle inutilement.
Je fait un test et vous donnerai une réponse.

Le Pingou · Answer

Bonjour,
Dans votre procédure il faut désactiver le mode de calcul automatique (à cause de la fonction SI() en colonne [Cause]). 
Vous insérez dans votre code l'instruction : 
Application.Calculation = xlCalculationManual
Entre  Y= Sh.... Et With Wo....
y = Sheets(2).Range("O2").Value
Application.Calculation = xlCalculationManual
With Worksheets(y)
Et réactiver le mode calcul automatique comme si dessous :
End With
Application.Calculation = xlCalculationAutomatic
End SubLe temps d'exécution est d'environ  2 à 4 secondes.

cousinhub29 · Answer

Re-

Le code (de Laurent Longre, gourou d'Excel)

Sub NettoieEtDerniereCellule()     ' Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long
On Error Resume Next
Calc = Application.Calculation
With Application
    .Calculation = xlCalculationManual
    .StatusBar = "Nettoyage en cours..."
    .EnableCancelKey = xlErrorHandler
    .ScreenUpdating = False
End With
For Each Sht In Worksheets
    If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
        Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
        If Not DCell Is Nothing Then
            Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
            Set DCell = Nothing
            Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
            If Not DCell Is Nothing Then _
                Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
        End If
    End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub



Par contre, je ne comprends pas "suivant les 2 conditions...."

@ te relire

Masquer une ligne sous deux conditions

10 réponses

Votre réponse

Newsletters