Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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 ?
 

Hasco

XLDnaute Barbatruc
Repose en paix
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 Barbatruc
Inactif
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 Barbatruc
Inactif
@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 !


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
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
sinon ça n'a aucun sens de faire deux subs
A mediter
 

soan

XLDnaute Barbatruc
Inactif
@patricktoulon

oh, ben j'ai juste fait avec l'énoncé, qui précisait pas qu'le nom des feuilles
pouvait changer ! 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 Barbatruc
Inactif
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

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 ?
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…