Macro à optimiser

Anthonymctm

XLDnaute Occasionnel
Bonjour à tous,

J'utilise une macro qui me permet de masquer les lignes dont la colonne N = 0.

VB:
Sub Masquer_D()
For Each C In Range("Descriptif!N3:N250")
        If C.Value = "0" Then
            Lgndebut = C.Row
            lgnfin = Lgndebut + Range(C.Address).MergeArea.Rows.Count - 1
            Worksheets("Descriptif").Rows(Lgndebut & ":" & lgnfin).EntireRow.Hidden = True
        End If
    Next
End Sub

Sauf qu'elle est super lente.. je me dis qu'il y a peut-être moyen de l'optimiser voire de la refaire différemment.

Merci à tous :)
 

Anthonymctm

XLDnaute Occasionnel
Si je test ta macro
VB:
Sub Masquer_D()
    Dim p As Range, plage As Range
    Set plage = Range("Descriptif!N3:N250")
    With plage
        For Each cel In plage.Cells
            If cel = "0" Then If p Is Nothing Then Set p = cel Else Set p = Union(p, cel.MergeArea)
        Next
    End With
  MsgBox p.EntireRow.address
 'p.EntireRow.Hidden = True'ligne a débloquer
End Sub

Meme avec "0", ça fonctionne et c'est rapide :)
 

Anthonymctm

XLDnaute Occasionnel
Bonjour Staple,

J'ai essayé :

VB:
Sub Masquer_III()
Dim LG&, t
t = Timer
Sheets.Add
Range("N2:N250").FormulaR1C1 = "=MOD(ROW(),ALEA.ENTRE.BORNES(1,25))"
Range("N2:N250").Value = Range("N2:N250").Value
LG = Cells(Rows.Count, "N").End(3).Row
Application.CutCopyMode = False
Application.ScreenUpdating = False
Cells(2, Columns.Count).Resize(LG - 1).Formula = "=IF(N2=0,""$"",1)"
Columns(Columns.Count).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True
Columns(Columns.Count).Delete
MsgBox "Staple " & Timer - t
End Sub

Ca ne fonctionne pas du tout.
Lors ce que les cellules sont groupé ça ne masque pas la première ligne du groupe.
Et surtout, ça remplace tous mes 1, 0 et formules donnant des 1 ou des 0 par #NOM?. :rolleyes:
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Anthonym ctm
Mea culpa (j'ai eu un petit souci de copier/coller)
En guise de pénitence, voici une version avec des couleurs et des commentaires pour expliquer le fonctionnement ;)
VB:
Sub Masquer_IV()
Dim LG&, t, pTest As Range, p As Range
t = Timer
'Création d'une feuille vide (pour pouvoir réaliser le test)
Sheets.Add
'remplissage de la plage N2:N50 avec des nombres et parmi eux quelques zéros
Set pTest = Range("N2:N50")
pTest.FormulaR1C1 = "=MOD(ROW(),RANDBETWEEN(2,12))"
'On transforme les formules en colonne N en valeurs seules
pTest = pTest.Value
'On détermine le numéro de ligne la dernière cellule non vide de la colonne N
LG = Cells(Rows.Count, "N").End(3).Row
'Dans la dernière colonne du classeur (rarememnt utilisée en génréral), on insére une formule:
'=SI(N2=;"$",1)
Cells(2, Columns.Count).Resize(LG - 1).Formula = "=IF(N2=0,""$"",1)"
'Grâce à SpecialCells, on détermine dans la dernière colonne , les cellules pour lesquelles la formule
'renvoie la valeur $ (qui est donc du texte)
Set p = Columns(Columns.Count).SpecialCells(xlCellTypeFormulas, 2)
'Mise en couleur des cellules =0 (juste pour test visuel)
Intersect(pTest, p.EntireRow).Interior.ColorIndex = 6
MsgBox "Masquer les lignes si cellule en colonne N=0", vbExclamation
'Cela permet de masquer les lignes correspondantes (sans passer par une boucle)
Application.ScreenUpdating = False
p.EntireRow.Hidden = True
Application.ScreenUpdating = True
'On supprime la dernière colonne qui contenait les formules
Columns(Columns.Count).Delete
MsgBox "Staple " & Timer - t
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Salut staple, plutôt qu'avoir une macro de test, tu peux pas juste me passer la macro qui va bien dans mon cas x)
Euh, c'est une blague? ;)
La macro déposée dans le message#2 fonctionne selon ce que tu expliques dans le 1er message.
Plus loin dans le fil, tu me demandes des explications sur le code.
Je te les fournis (certes avec retard) mais la logique de masquage des lignes sont identiques dans la macro du message#2 et dans la dernière que j'ai posté.
 

Anthonymctm

XLDnaute Occasionnel
Oui non mais d'accord, mais la j'ai un timer, un ajout de page etc, je dois enlever quoi ? (les explications c'est très bien merci !)

Edit: je viens de tester et ça fait un peu nimporte quoi :S
Ca me rajoute plein de nombre la ou c'était vide, ça me modifie mes zéro et 1 par d'autres chiffres.. :S
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Anthonym ctm
Remettons les choses en perspective
La macro du message#2 est censée fonctionner telle quelle selon le cahier des charges exprimé dans ton message#1
Masquer les lignes si 0 dans cellule dans la plage N2:N250

Les macros suivantes (depuis le message#13)
(comme cela a bien été préciser dans mes différents messages) sont des macros de test
Et vers la fin du fil, j'ai ajouté la création une feuille vide justement pour créer un test qui n'impactera aucune des feuilles de tes classeurs (puisqu'il s'agit de tests)
Ce sont juste des macros qui sont censés t'expliquer comment fonctionne la macro du message#2
PS: Le timer a été ajouté par patricktoulon

Donc si on résume, seule la macro du message#2 a vocation a être utilisée sur ton classeur.
 

Anthonymctm

XLDnaute Occasionnel
Salut Staple,
Du coup je comprend pas, dans ton message 34 tu dis que t'as eu une erreur de copier/coller.

Après si je prend la macro du message 2 ça va pas non plus :S

Ça me masque toutes lignes même quand N est vide alors qu'il faut que ça se masque que quand N=0.

Et ça ne tiens pas compte non plus des cellules fusionnées si de N31 à N35 c'est fusionné et égal à 1 ou en tout cas différents de 0 il faut qu'aucune ligne ne soit masquée. Là elle le sont toutes sauf la 31.
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

anthony
Ton message#1 ne parlait pas de cellules fusionnées
Juste pour te montrer que la macro#2 fonctionnait
(selon ce qui était décrit dans le message#1)
Dans un classeur vierge, lance la macro ci-dessous
VB:
Sub Macro1()
With Range("N1:N2")
.Value = Application.Transpose(Array(1, 0))
.AutoFill Destination:=Range("N1:N10"), Type:=xlFillCopy
End With
End Sub
Tu es bien d'accord qu'il y alors des 0 dans la colonne N
Ensuite lance la macro#2 (que je remets ici)
VB:
Sub Masquer()
Dim LG&
LG = Cells(Rows.Count, "N").End(3).Row
Application.ScreenUpdating = False
Cells(2, Columns.Count).Resize(LG - 1).Formula = "=IF(N2=0,""$"",1)"
Columns(Columns.Count).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True
Columns(Columns.Count).Delete
End Sub
Les lignes avec 0 sont bien masquées, non ?
 

Anthonymctm

XLDnaute Occasionnel
Oui très bien, ça masque si N=0, mais j'ai pas demandé à ce que ça masque aussi si N est vide.

Je te remercie pour ton temps, j'ai pris la macro de Patrick qui va très bien, dans tous les cas de figure dont j'ai besoin et qui est très rapide
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous :),

Je veux jouer aussi :p.
Voir la méthode de ma pomme dans le fichier joint (j'ai retenu les valeurs égale à "0").
La méthode de @Anthonymctm ne m'apparait pas spécialement lente (une fois ajoutée au début l'instruction: Application.ScreenUpdating=False)
Pour 30 096 enregistrements, la macro d'Anthony s'exécute en environ 2,27 seconde (voir fichier avec les deux macros)
 

Pièces jointes

  • Anthonymctm- masquer ligne- v1.xlsm
    273.2 KB · Affichages: 14

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Anthonymctm :)

Quelle lignes je dois enlever dans ta macro pour supprimer le timer ?

Utiliser le code ci-dessous :
VB:
Sub Masquer_mpm()    'mapomme
Dim derlig&, t, i&, aSuppr$, h&
   Application.ScreenUpdating = False
   With Sheets("Descriptif")
      .Select
      If .FilterMode Then .ShowAllData
      .Rows.Hidden = False
      derlig = .Cells(.Rows.Count, "n").End(xlUp).Row
      If derlig = 1 Then Exit Sub
      t = .Range("n1:n" & derlig): i = 2
      Do
         If t(i, 1) = "0" Then
            h = .Cells(i, "n").MergeArea.Count
            aSuppr = aSuppr & "," & .Cells(i, 1).Resize(h).EntireRow.Address(0, 0)
            i = i + h
            If Len(aSuppr) > 230 Then
               .Range(Mid(aSuppr, 2)).RowHeight = 0
               aSuppr = ""
            End If
         Else
            i = i + 1
         End If
      Loop While i <= derlig
      If Len(aSuppr) > 0 Then .Range(Mid(aSuppr, 2)).RowHeight = 0
   End With
End Sub

nota : vous pouvez supprimer la procédure INIT
 

Discussions similaires

Réponses
7
Affichages
292

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo