Résolu 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 :)
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Une possibilité
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
 

ml121

XLDnaute Nouveau
Bonjour,

Pas du tout un pro du VBA, mais que pensez vous de ça :

Option Explicit

Sub Masquer_M()
Dim i As Integer
Dim oCell As Range

For i = 3 To 250

Set oCell = Range("N" & i)

If oCell.Value = 0 Then
oCell.EntireRow.Hidden = True
End If
Next
End Sub
 

Anthonymctm

XLDnaute Occasionnel
Bonjour Staple,

Ca semble fonctionner, et rapidement !

Tu peux me détailler la fonctionnalité de chacune des lignes stp que je comrpenne un peu mieux ton code. :)
 

Staple1600

XLDnaute Barbatruc
Re

Alors
LG identifie la dernière cellule non vide de la colonne N

En génèral, pour comprendre un code, on peut abuser des MsgBox ;)
VB:
Sub Masquer_II()
Dim LG&, T$
LG = Cells(Rows.Count, "N").End(3).Row
MsgBox LG 'test
Application.ScreenUpdating = False
MsgBox Cells(2, Columns.Count).Resize(LG - 1).Address 'test
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
 

Anthonymctm

XLDnaute Occasionnel
Pardon mais je comprend pas, je suis plutôt une quiche en VBA. ^^'

Voilà, ce que je comprend mdr

VB:
Sub Masquer()
Dim LG& 'determine la variable LG en tant que..?'
LG = Cells(Rows.Count, "N").End(3).Row 'LG = la dernière ligne avec N non vide'
Application.ScreenUpdating = False 'pas de màj d'écran..?
Cells(2, Columns.Count).Resize(LG - 1).Formula = "=IF(N2=0,""$"",1)" 'Ecris la formule quelque part ?'
Columns(Columns.Count).SpecialCells(xlCellTypeFormulas, 2).EntireRow.Hidden = True 'defini des colonnes en format special et masque la ligne entière ?'
Columns(Columns.Count).Delete 'supprimer les colonnes..?'
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Dim LG
'Déclaration de la variable LG, typée en Long
'Et LG correpond à ce que j'ai expliqué dans mon précédent message
Si tu utilises les MsgBox comme montré dans le message#6, tu sauras où est copiée la formule et donc voir le contenu de cette formule.

Et pour SpecialCells et xlCellTypeFormulas, l'aide de VBA peut te renseigner
ou à défaut tout bon moteur de recherche ;)

PS: Débuter en VBA n'est pas synonyme de laisser sa curiosité au vestiaire ;)
Dans ce siècle qui est le nôtre, et avec ce fabuleux outil qu'est le net, laisser parler et nourrir sa curiosité est un vrai plaisir ;)
 

Anthonymctm

XLDnaute Occasionnel
Ok...

Si je demande l'explication de la macro c'est bien que je suis curieux de comprendre le code..

Pour l'aide de SpecialCells j'obtiens "Renvoie un objet Range qui représente toutes les cellules correspondant au type et à la valeur spécifiés. "
Super, me voilà pas plus avancé.

Merci quand même :)
 

Staple1600

XLDnaute Barbatruc
Re

Je sais que tu demandes mais j'invite toujours le demandeur à mettre les mains dans le cambouis ;)
(C'est toujours plus gratifiant de trouver par soi-même, non ?)
Alors voici de quoi mettre les mains dans le cambouis, essaies cette petite macro de test (sur un classeur vierge)
VB:
Sub SpecialCell()
Range("A1:C10") = Array(1, "=ROW()*COLUMN()", "ABC")
'renvoie l'adresse des cellules avec formules...
MsgBox Range("A1:C10").SpecialCells(xlCellTypeFormulas, 1).Address
'renvoie l'adresse des cellules avec formules...
MsgBox Range("A1:C10").SpecialCells(xlCellTypeFormulas, 2).Address
'PS: c'est cette syntaxe que j'ai utilisé dans la macro pour masquer: le paramètre 2
End Sub
[NB]: Tu as été voir quelle était la formule que j'utilisais pour masquer les lignes?
(Normalement, tu sais desormais qu'elle se trouve dans la dernière colonne ;))
 
Dernière édition:

patricktoulon

XLDnaute Impliqué
bonsoir
sinon en vba dans ta boucle c'est peut être lent par ce que tu hide les lignes une par une
alors que si tu stocke le mergearea de chaque cells dans un union
tu peu masquer tout d'un coup après boucle
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
 

Staple1600

XLDnaute Barbatruc
Bonsoir patricktoulon

patricktoulon
Si tu as le temps (moi je ne peux pas, je suis de corvée de pluche pour la soupe ;)), je serais curieux de savoir quel code s'éxécute le plus rapidement en ta boucle et ma "non-boucle" ? ;)
 

Staple1600

XLDnaute Barbatruc
Re,

Anthonymctm
Un autre petit test pour mieux éclairer ta lanterne
Code:
Sub Test_II()
Range("A1:C10") = Array(1, "=ROW()*COLUMN()", "ABC")
spCell2 Range("A1:C10"), xlCellTypeFormulas, xlNumbers
spCell2 Range("A1:C10"), xlCellTypeConstants, xlTextValues
spCell2 Range("A1:C10"), xlCellTypeConstants, xlNumbers
End Sub
Private Sub spCell2(Plage As Range, cType As XlCellType, X As XlSpecialCellsValue)
MsgBox Plage.SpecialCells(cType, X).Address
End Sub
PS: Petite astuce, grâce à Intellisence, si tu personnalises la ligne dans la macro, tu auras une liste des differents choix possibles.
O1_SpecialCells.jpg
 
Dernière édition:

patricktoulon

XLDnaute Impliqué
bonsoir Staple1600
par exeperience sauf quelques exception les fonction excel sont plus rapides mais!!.. il arrive parfois que non
je peux tester nos deux solutions avec un timer si tu veux
mais entre nous 250 lignes si c'est lent c'est qu'il y a un autre élément (que l'on a pas) a prendre en compte
 

Staple1600

XLDnaute Barbatruc
Re


Attendons que le demandeur repasse pour qu'il nous fournisse plus d'éléments
(Quant à moi, j'ai ajouté quelques explications et tests dans le message#13 ;))
 

patricktoulon

XLDnaute Impliqué
re
bon ben j'ai testé et c'est le toulonnais qui gagne
VB:
Sub Masquer_D1()
    Dim p As Range, plage As Range, t
    t = Timer
    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 "patrick " & Timer - t & vbCrLf & p.EntireRow.Address
 'p.EntireRow.Hidden = True'ligne a débloquer
End Sub
Sub Masquer()
Dim LG&, t
t = Timer
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
MsgBox "stapple " & Timer - t
End Sub
avec ta methode j'ai un timer 0.0235xxxxxx
avec la mienne 0
et en plus soit c'est moi qui est pas compris le but soit ta méthode n'est pas adaptée
je me retrouve avec les lignes 2 a 26 masquées

demo staple
demo3.gif

demo patrick
demo2.gif
 

Staple1600

XLDnaute Barbatruc
Re

J'ai testé le code chronométré (sur XP/XL2K3)
Chez moi, c'est mon code qui est rapide(et les deux codes ne font pas la même chose, sauf erreur de ma part)
 

patricktoulon

XLDnaute Impliqué
re
oui visiblement il ne font pas la même chose
tu masque de la cell1 a la derniere.mergearea
moi je masque de les cells concernées avec leurs fusion si c'est le cas
 

Staple1600

XLDnaute Barbatruc
Re

Pas sur que le Timer renvoie un temps des plus juste ;)
Un coup, mon code est plus rapide, un coup c'est le tien ??Bizarre, non ?
NB: Réafficher manuellement entre chaque éxécution des macros
VB:
Sub Masquer_D1()
    Dim p As Range, plage As Range, t
    t = Timer
    Set plage = ActiveSheet.Range("N2:N250")
    plage.FormulaR1C1 = "=MOD(ROW(),ALEA.ENTRE.BORNES(1,25))"
    plage.Value = plage.Value
    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 "patrick " & Timer - t '& vbCrLf & p.EntireRow.Address
 'p.EntireRow.Hidden = True'ligne a débloquer
End Sub
Sub Masquer()
Dim LG&, t
t = Timer
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.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
 

Discussions similaires


Haut Bas