Résolu Simplification de code - Délais d'affichage

MarcMad

XLDnaute Nouveau
Bonjour, j'ai crée ce code et il fonctionne comme je le veux.
Par contre, j'obtiens un délais d'affiche.
Je pense que ce code pourrait être simplifier pour accélérer l'exécution de celui-ci.

Merci

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False

With Worksheets("Estimation rapide")

If .Range("O6").Value = Empty Then
Worksheets("Estimation").Rows("21:26").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("21:26").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O8").Value = Empty Then
Worksheets("Estimation").Rows("27:32").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("27:32").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O10").Value = Empty Then
Worksheets("Estimation").Rows("33:38").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("33:38").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O12").Value = Empty Then
Worksheets("Estimation").Rows("39:44").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("39:44").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O14").Value = Empty Then
Worksheets("Estimation").Rows("45:50").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("45:50").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O16").Value = Empty Then
Worksheets("Estimation").Rows("51:56").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("51:56").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O18").Value = Empty Then
Worksheets("Estimation").Rows("57:62").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("57:62").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O20").Value = Empty Then
Worksheets("Estimation").Rows("63:68").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("63:68").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O21").Value = Empty Then
Worksheets("Estimation").Rows("69:74").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("69:74").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O22").Value = Empty Then
Worksheets("Estimation").Rows("75:80").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("75:80").EntireRow.Hidden = False

End If
End With

With Worksheets("Estimation rapide")

If .Range("O6").Value = Empty Then
Worksheets("Estimation").Rows("81:83").EntireRow.Hidden = True
Else
Worksheets("Estimation").Rows("81:83").EntireRow.Hidden = False

End If
End With

End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Marc,
Utiliser les balises </> pour le code c'est plus lisible ... et le copié est automatique.
Un premier jet simple :
VB:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual ' Utile si beaucoup de formules dans la feuille
With Worksheets("Estimation rapide")
    Worksheets("Estimation").Rows("21:83").EntireRow.Hidden = False
    If .Range("O6").Value = Empty Then Worksheets("Estimation").Rows("21:26").EntireRow.Hidden = True
    If .Range("O8").Value = Empty Then Worksheets("Estimation").Rows("27:32").EntireRow.Hidden = True
    If .Range("O10").Value = Empty Then Worksheets("Estimation").Rows("33:38").EntireRow.Hidden = True
    If .Range("O12").Value = Empty Then Worksheets("Estimation").Rows("39:44").EntireRow.Hidden = True
    If .Range("O14").Value = Empty Then Worksheets("Estimation").Rows("45:50").EntireRow.Hidden = True
    If .Range("O16").Value = Empty Then Worksheets("Estimation").Rows("51:56").EntireRow.Hidden = True
    If .Range("O18").Value = Empty Then Worksheets("Estimation").Rows("57:62").EntireRow.Hidden = True
    If .Range("O20").Value = Empty Then Worksheets("Estimation").Rows("63:68").EntireRow.Hidden = True
    If .Range("O21").Value = Empty Then Worksheets("Estimation").Rows("69:74").EntireRow.Hidden = True
    If .Range("O22").Value = Empty Then Worksheets("Estimation").Rows("75:80").EntireRow.Hidden = True
    If .Range("O6").Value = Empty Then Worksheets("Estimation").Rows("81:83").EntireRow.Hidden = True
End With
Application.Calculation = xlCalculationAutomatic
End Sub
Répéter With Worksheets("Estimation rapide") ne sert à rien, on peut le mettre pour l'ensemble de la macro.
En mettant Worksheets("Estimation").Rows("21:83").EntireRow.Hidden = False au début de la macro, cela évite de multiple ligne de codes.
Mais il y a surement plus rapide. Wait and see.
NB : Je n'ai pas compris le double .Range("O6") , peut être une erreur ?
 

Roblochon

XLDnaute Barbatruc
Bonjour,

Je ne sais si vous pourrez diminuer le temps d'affichage, ne connaissant rien de votre fichier, mais vous pouvez déjà raccourcir votre macro :
VB:
Private Sub Worksheet_Activate()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Estimation")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With Worksheets("Estimation rapide")
        ws.Rows("21:26").EntireRow.Hidden = .Range("O6").Value = Empty
        ws.Rows("27:32").EntireRow.Hidden = .Range("O8").Value = Empty
        ws.Rows("33:38").EntireRow.Hidden = .Range("O10").Value = Empty
        ws.Rows("39:44").EntireRow.Hidden = .Range("O12").Value = Empty
        ws.Rows("45:50").EntireRow.Hidden = .Range("O14").Value = Empty
        ws.Rows("51:56").EntireRow.Hidden = .Range("O16").Value = Empty
        ws.Rows("57:62").EntireRow.Hidden = .Range("O18").Value = Empty
        ws.Rows("63:68").EntireRow.Hidden = .Range("O20").Value = Empty
        ws.Rows("69:74").EntireRow.Hidden = .Range("O21").Value = Empty
        ws.Rows("75:80").EntireRow.Hidden = .Range("O22").Value = Empty
        ws.Rows("81:83").EntireRow.Hidden = .Range("O6").Value = Empty
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Quand vous masquez/affichez des ligne, l'évènement Worksheet_SelectionChange peut être appelé. D'où le Application.EnableEvents = False ci-dessus

.Range("O6").Value = Empty Va renvoyer True ou False, inutile de tester dans un IF

Cordialement

[Edition] macro modifiée à 16:02 (ajout de l'objet worksheet ws)
 
Dernière édition:

soan

XLDnaute Accro
Bonjour @MarcMad, le fil,

Je propose ce code VBA :
VB:
Option Explicit

Private Sub Job(ligs$, cel$)
  Worksheets("Estimation").Rows(ligs).Hidden = _
    IsEmpty(Worksheets("Estimation rapide").Range(cel))
End Sub

Private Sub Worksheet_Activate()
  Application.ScreenUpdating = 0
  Job "21:26", "O6": Job "27:32", "O8": Job "33:38", "O10": Job "39:44", "O12"
  Job "45:50", "O14": Job "51:56", "O16": Job "57:62", "O18": Job "63:68", "O20"
  Job "69:74", "O21": Job "75:80", "O22": Job "81:83", "O6"
End Sub
soan
 

patricktoulon

XLDnaute Barbatruc
bonjour a tous
j'ajoute la mienne
l'idée de Soan est pas mal ,je la simplifie vu que les offset de "rapide" sont réguliers
r2 est donc un seul area
VB:
Option Explicit

Private Sub Job(r1 As Range, r2 As Range)
    Dim i: Application.ScreenUpdating = False
    For i = 1 To r1.Areas.Count: r2.Offset(6 * (i - 1)).EntireRow.Hidden = IsEmpty(r1.Areas(i)): Next
End Sub

Sub test()
    Dim r1 As Range, r2 As Range
    Set r1 = Sheets("Estimation").Range("O6,O8,O10,O12,O14,O16,O18,O20,O21,O22,O6")
    Set r2 = Sheets("Estimation rapide").Range("21:26")
    Job r1, r2
End Sub
 

soan

XLDnaute Accro
@patricktoulon

oui, c'est bien vu ! :) je l'ai bêtement manqué car j'étais occupé à optimiser le reste. ;)

mais à c'moment-là, si j'm'en étais aperçu, j'aurais plutôt fait comme ci-dessous ;
le « plutôt » est par rapport à mon code VBA précédent, pas celui de Patrick ! :p


VB:
Option Explicit

Dim T, lg1&, i As Byte

Private Sub Job()
  Dim lg2&: lg2 = lg1 + 5
  Worksheets("Estimation").Rows(lg1 & ":" & lg2).Hidden = _
    IsEmpty(Worksheets("Estimation rapide").Range(T(i)))
  lg1 = lg2 + 1
End Sub

Private Sub Worksheet_Activate()
  T = Array("O6", "O8", "O10", "O12", "O14", "O16", "O18", "O20", "O21", "O22", "O6")
  lg1 = 21: Application.ScreenUpdating = 0: For i = 0 To 10: Job: Next i
End Sub
soan
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
non :p
par ce que tu peux pas t'en resservir en changeant l'array ,tu est obligé de changer les feuille dans la sub appelée alors que tout les arguments devraient être dans la sub appelante ;)
c'est comme ça que procéder tu dois Les maître jedi | star wars nico
sinon ça n'a aucun sens de faire deux subs
A mediter;)
 

soan

XLDnaute Accro
@patricktoulon

oh, ben j'ai juste fait avec l'énoncé, qui précisait pas qu'le nom des feuilles
pouvait changer ! :p si c'est juste ça, nouvelle version (MarcMad sera ravi) :

VB:
Option Explicit

Dim F1$, F2$, T, lg1&, i As Byte

Private Sub Job()
  Dim lg2&: lg2 = lg1 + 5
  Worksheets(F1).Rows(lg1 & ":" & lg2).Hidden = _
    IsEmpty(Worksheets(F2).Range(T(i)))
  lg1 = lg2 + 1
End Sub

Private Sub Worksheet_Activate()
  F1 = "Estimation": F2 = "Estimation rapide"
  T = Array("O6", "O8", "O10", "O12", "O14", "O16", "O18", "O20", "O21", "O22", "O6")
  lg1 = 21: Application.ScreenUpdating = 0: For i = 0 To 10: Job: Next i
End Sub
@MarcMad

bonne nouvelle, que ce soit résolu ! :)
(tu as même une 3ème version ci-dessus !)


soan
 

soan

XLDnaute Accro
Bonjour Patrick,

Je connais les globules blancs et les globules rouges, mais j'sais pas c'que c'est,
tes « globale modules » ! késako ? j'connais aussi l'niveau global d'un module
pour y mettre des variables globales ; c'est de ça que tu parles ?


soan
 

patricktoulon

XLDnaute Barbatruc
re
j'connais aussi l'niveau global d'un module

pour y mettre des variables globales ; c'est de ça que tu parles ?

oui c'est de ça que je parles
des variables globales module qui sont instanciée dans une sub d'appel pour être utilisées dans une sub appelée :eek:

tu gagnerais a réviser le chapitre "porté d'une variable" dans vba et de son utilité et par conséquent de son utilisation ;)

cela dit ça fonctionne pas de soucis

j'attire ton attention aussi et m'interroge sur cette manie que tu a d'utiliser un array de string pour tes address et la transformation en range dans la sub appelée

pour quoi ne pas faire comme j'ai montré précédemment
T = Array("O6", "O8", "O10", "O12", "O14", "O16", "O18", "O20", "O21", "O22", "O6")



cette petite macro devrait t'éclairer sur le sens de ma critique

VB:
sub apellante()
dim t as range
set t=sheets(1).range("O6,O8,O10,O12,O14,O16,O18,O20,O21,O22,O6")
appelée t
end sub

sub appelée(t)
for i= 1 to t.areas.count
msgbox t.areas(i).address & " :  type " & typename (t.areas(i)) &" : dans feuille : " & t.parent.name
next
end sub
pas de variable globale!!!!
pas de variable feuille !!!!!!
pas de transformation array/range

pourtant dans cet exemple et pour chaque range le type,l'address, le parent feuille est bien identifié
quand tu te promène de sub en sub avec une variable instancié dans l'une d'entre elles ,la variable est promenée avec toutes ses property!!!!!!!!;)

vois tu ou je veux en venir maintenant ?;)
 

soan

XLDnaute Accro
oh là, y'a beaucoup d'choses dans ton post ! j'ai pas l'temps de
tout lire attentivement maint'nant, mais j'le lirai plus tard :
peut-être demain, ou après-demain.


soan
 

soan

XLDnaute Accro
ajout à mon post #15 de 10 h 37

comme tu es bien meilleur que moi avec Excel, je vais te poser une colle très difficile :

voilà : je sais pas ce qu'il se passe au juste, mais je crois que ma version d'Excel est ensablée ;
quand j'utilise Excel environ un peu plus de 6 ou 8 h d'affilée, il commence à dérailler, et
il affiche un message d'erreur hypnotique sur mon écran pour essayer de me commander ;
c'est écrit : « dors, je le veux ! dors, je le veux ! » ; bon, alors, comme il est vraiment très, très
convaincant, je ne peux pas m'empêcher de commencer à fermer les yeux ! je crois qu'il a
été infecté par le virus tsé-tsé, ou le virus curare ; t'aurais pas une solution pour qu'Excel
accepte de jouer avec moi 24 h / 24, sans qu'il s'amuse à jouer aux marchands de sable ?

ah ben tiens, ça y'est ! le voilà qui recommence ! bon, alors je vais être obligé d'te quitter,
et d'éteindre le PC avant qu'il me commande d'aller m'jeter sous un pont dans les bras de
Morphée ; le plus bizarre, c'est qu'une recherche google sur cette erreur hypnotique dit :
" « Une erreur s’est produite lors de l’envoi de commandes au programme » dans Excel " ;
pourtant, j't'assure que c'est bien lui qui essaye de m'commander, pas l'inverse ! :confused:

si ça peut aider : j'ai Excel version « Mandrake » ;)


soan
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas