Simplification de code - Délais d'affichage

M

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
 
Trier par date Trier par votes
sylvanu

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 ?
 
Vote positif 0 Vote négatif
Hasco

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:
Vote positif 0 Vote négatif
S

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
 
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
S

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 ! :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:
Vote positif 0 Vote négatif
patricktoulon

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;)
 
Vote positif 0 Vote négatif
S

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 ! :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
 
Vote positif 0 Vote négatif
S

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
 
Vote positif 0 Vote négatif
patricktoulon

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 ?;)
 
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Code afficher/Masquer problème
Réponses
10
Affichages
205
chaelie2015
chaelie2015
PatFr38
  • Résolu(e)
Microsoft 365 Code VBA pour vérifier si lignes masquées le sont bien
2
Réponses
16
Affichages
713
PatFr38
PatFr38
L
  • Question
XL 2016 code VBA - masque afficher des lignes
Réponses
3
Affichages
384
Jacky67
Jacky67
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
342
M@xu3L
M
L
  • Résolu(e)
XL 2016 finaliser mon code VBA
Réponses
8
Affichages
458
Linda42
L
C
  • Question
XL 2019 Tableau- creation de lignes: probleme de hauteur de lignes
Réponses
6
Affichages
375
Cheyenne_2021
C
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Efface automatiquement le contenu d'une cellule en fonction d'une autre cellule
Réponses
9
Affichages
273
chaelie2015
chaelie2015
L
  • Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
254
vgendron
vgendron
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
346
crocrocro
C
P
  • Résolu(e)
Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)
Réponses
8
Affichages
314
pat66
P

Membres actuellement en ligne

12 membres et 262 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 078
Messages
2 085 111
Membres
102 783
dernier inscrit
Basoje