Masquer une ligne sous deux conditions

Utilisateur anonyme -
Utilisateur anonyme - 24 sept. 2010 à 17:33

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

A voir également:

Masquer une ligne sous deux conditions
Partager photos en ligne - Guide
Mètre en ligne - Guide
Masquer une conversation whatsapp - Guide
Deux ecran pc - Guide
Comment faire deux colonnes sur word - Guide

10 réponses

Réponse 1 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

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

Utilisateur anonyme

merci, mais je ne remarque aucun changement toujours aussi lent.

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
Trop lent ne veut rien dire, pouvez-vous indiqué la grandeur du fichier à traiter et le temps d'exécution de la procédure?
Salutations.
Le Pingou

Utilisateur anonyme

Bonjour,

Mon fichier a une taille totale de 6,51 MO.
Sur la feuille où s'exécute la macro il n'y a pour le moment que 95 lignes (ça évolue dans le temps). Elle m'a mis 10 min pour me masquer les lignes en questions.

Laure

Réponse 2 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

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

Utilisateur anonyme

Merci, mais ce code la ne me masque rien du tout.

Réponse 3 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

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

toujours rien, cette macro m'affiche juste la feuille.

Réponse 4 / 10

Utilisateur anonyme

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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

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

Utilisateur anonyme

Merci, je ne sais pas pourquoi mais ça ne marche pas; j'ai ceci en jaune :

.AutoFilter Field:=1, Criteria1:=Sheets(2).Range("M2").Value

Réponse 6 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

Re-,

J'ai fait plusieurs essais, et pas de soucis...

Que mets-tu comme conditions, dans la page "Menu"?

@ te relire

Utilisateur anonyme

c'est bizzare chez moi ça ne marche pas.
pourrais tu mettre en lien le fichier où ça marche s'il te plaît.

Réponse 7 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

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

Utilisateur anonyme

Merci, mais je constate que pour que votre code me masque les lignes suivants les deux conditions demandées il me faut l'activer deux fois.
Quel est ce code de nettoyage? J'aimerai bien alléger le vrai fichier.

Réponse 8 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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.

Réponse 9 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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 Sub

Le temps d'exécution est d'environ 2 à 4 secondes.

Utilisateur anonyme

Merci
c'est beaucoup mieux !

Réponse 10 / 10

cousinhub29 Messages postés 1074 Date d'inscription Statut Membre Dernière intervention 361

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

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
Juste au passage, il y a souvent des éléments qui restent dans les cellules inutilisées.
Donc, on recherche la dernière colonne utile est on supprime toutes les autres puis de même pour les lignes. Et ainsi le classeur et de nouveau minimaliser.
Salutations.
Le Pingou

Utilisateur anonyme

Merci

Pourrais tu s'il te plaît m'expliquer ce que cette macro fait au juste (j'ai essayé de comprendre son fonctionnement mais bon ... je ne voudrai pas par erreur modifier un des code qui marche de mon fichier).

Discussions similaires

Que veut dire "correspondant occupé" lors d'un appel ?

Votre réponse

Discussions similaires