Simplification de code - Délais d'affichage

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion MarcMad
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

MarcMad

Guest
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
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
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
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
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
@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:
Vote positif 0 Vote négatif
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
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
@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
 
Vote positif 0 Vote négatif
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
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 ?😉
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

P
  • Résolu(e)
Microsoft 365 macro qui permet de basculer entre 2 valeurs composées de formules de type "Formula local"
2
Réponses
15
Affichages
495
cathodique
cathodique
anthoYS
  • Résolu(e)
XL 2019 Comment modifier ces codes VB de sorte que le clic droit sur un commentaire présent, permette l'édition et non cette erreur (capture) ?
Réponses
6
Affichages
202
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Insérer un commentaire prêt à saisir de B à X sans limite... (excepté en ligne 1 ; taille de commentaire Ok déjà voir code VB en B*)
Réponses
7
Affichages
242
Nicolas JACQUIN
Nicolas JACQUIN
F
  • Question Question
Autres Listbox-transfère la recherche dans une ListBox vers une feuille de calcul
2
Réponses
18
Affichages
388
dysorthographie
dysorthographie
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
836
TooFatBoy
TooFatBoy
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
423
sylvanu
sylvanu
anthoYS
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
249
anthoYS
anthoYS
KTM
  • Question Question
XL 2016 Filtrer plage via le contrôle ActiveX : combobox
Réponses
7
Affichages
496
KTM
KTM
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
2 K
Dranreb
Dranreb
L
  • Question Question
Microsoft 365 Erreur automation 440 sur code VBA
Réponses
1
Affichages
372
job75
job75
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
408
nabilexcel2007
N
E
  • Question Question
XL 2019 Boite de dialogue Save as affiche mauvaise extension
Réponses
9
Affichages
552
patricktoulon
patricktoulon
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
849
candido57
C
M
  • Question Question
XL 2021 Fichier partagé - erreur de l'objet TextRange2
Réponses
7
Affichages
491
macseb
M
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
591
un internaute
U
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Code afficher/Masquer problème
Réponses
10
Affichages
751
chaelie2015
chaelie2015
P
  • Résolu(e)
Microsoft 365 Afficher ou masquer formes si une cellule est vide
Réponses
11
Affichages
620
pat66
P
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
774
thunder23
thunder23
Electron24
  • Résolu(e)
Microsoft 365 Virgules dans ListView
Réponses
5
Affichages
451
Electron24
Electron24
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
Retour