Simplification de code - Délais d'affichage

MarcMad · 14 Octobre 2020

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 · 14 Octobre 2020

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 · 14 Octobre 2020

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)

soan · 15 Octobre 2020

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 · 15 Octobre 2020

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 · 15 Octobre 2020

@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

patricktoulon · 15 Octobre 2020

re
oui ca marche aussi mais!!!! sais tu pourquoi j’adhère pas a ta dernière ??,

soan · 15 Octobre 2020

euh... pa'c'qu'elle est antidérapante ?

soan

patricktoulon · 15 Octobre 2020

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

MarcMad · 15 Octobre 2020

Merci pour vos propositions et vos conseil !

Résolu

soan · 16 Octobre 2020

@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

patricktoulon · 16 Octobre 2020

re
Bonjour @soan
des globale modules !!!?????

soan · 16 Octobre 2020

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 · 16 Octobre 2020

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 ?

soan · 16 Octobre 2020

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

Simplification de code - Délais d'affichage

MarcMad

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

MarcMad

XLDnaute Nouveau

soan

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

Discussions similaires