XL 2019 Comment Accélérer cette macro

pat66 · 30 Octobre 2020

Bonjour Le forum,

j'ai besoin d'aide pour accélérer cette macro, pensez vous que cela soit possible et auriez vous la gentillesse de me dire comment faire ?
Merci d'avance pour votre temps
Patrick

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Cursor = xlWait 'sablier
Application.Calculation = xlCalculationManual
If Not Application.Intersect(Target, Range("AE5")) Is Nothing Then
Rows("31:50").EntireRow.Hidden = False
If Range("ae5").Value = 6 Then Rows("31:50").EntireRow.Hidden = True
If Range("ae5").Value = 9 Then Rows("34:50").EntireRow.Hidden = True
If Range("ae5").Value = 12 Then Rows("37:50").EntireRow.Hidden = True
If Range("ae5").Value = 15 Then Rows("40:50").EntireRow.Hidden = True
If Range("ae5").Value = 20 Then Rows("45:50").EntireRow.Hidden = True
If Range("ae5").Value = 25 Then Rows("50:50").EntireRow.Hidden = True

If Range("AE5") <> "9" Then
'Columns("AT").EntireColumn.Visible = False
'Else
Columns("AT").EntireColumn.Hidden = True
End If
If Range("AS17").Value <> "0" And Range("AE5").Value <> "9" Then
ret = MsgBox("Si vous changez la durée d'utilisation, le montant sera réinitialisé ! ", vbYesNo + vbQuestion, "PL")
If ret = vbYes Then
Range("AS17").Value = 0
Else
Range("AE5").Value = 9
End If
End If
End If
Application.ScreenUpdating = True
Application.Cursor = xlDefault 'sablier
Application.Calculation = xlCalculationAutomatic
' If Target.Address <> "$AE$5" Then Exit Sub
' If Target.Value = "9" Then
' ActiveSheet.Shapes("OK").Visible = True
' Else
' ActiveSheet.Shapes("OK").Visible = False
' End If
End Sub

fanfan38 · 30 Octobre 2020

Bonjour
Avec in select case
select case range("ae5")
case=6
Rows("31:50").EntireRow.Hidden = True
case=9
Rows("34:50").EntireRow.Hidden = True
case=12
Rows("37:50").EntireRow.Hidden = True
case=15
Rows("40:50").EntireRow.Hidden = True
case= 20
Rows("45:50").EntireRow.Hidden = True
case= 25
Rows("50:50").EntireRow.Hidden = True
end select

A+ François

Softmama · 30 Octobre 2020

Bonjour,

Ce bout de macro ne génère aucune boucle et devrait donc être très rapide à l'exécution, d'autant que tu as pris le soin de geler le ScreenUpdating et le Calculation. Tu peux ajouter également en début de macro :

Application.EnableEvents = False

et en fin de macro :

Application.EnableEvents = True

soan · 30 Octobre 2020

Bonjour,

je propose ce petit bout de code VBA :

VB:

Dim lig As Byte
Rows("31:50").Hidden = 0
Select Case [AE5]
  Case 6: lig = 31
  Case 9: lig = 34
  Case 12: lig = 37
  Case 15: lig = 40
  Case 20: lig = 45
  Case 25: lig = 50
End Select
Rows(lig & ":50").Hidden = -1

soan

pat66 · 31 Octobre 2020

Bonjour

Un grand merci a tous pour ces alternatives, je vais les tester ce we et je reviens vers vous

bon we

Patrick

pat66 · 1 Novembre 2020

Bonjour

Après plusieurs essais, il s'avère que la solution de soan est un peu plus rapide que la mienne et en tout cas plus rapide que celle de fanfan38
J'ai aussi ajouté enable events comme le préconise Softmama

Encore merci à tous les 3

bon dimanche

Patrick66

Staple1600 · 1 Novembre 2020

Bonjour le fil

Juste parce que les minutes sont longues

VB:

Sub PourLeFun_Confinement_Oblige()
Dim t
t = Array(Array(6, 31), Array(9, 34), Array(12, 37), Array(15, 40), Array(20, 45), Array(25, 50))
Rows("31:50").Hidden = 0: Rows(Application.VLookup([AE5], t, 2, 0) & ":50").Hidden = -1
End Sub

NB: A tester dans un module standard tel quel.
Ou à intégrer dans une procédure Worksheet (comme dans le message#1)

Staple1600 · 1 Novembre 2020

Re

Une variante (avec effets de bord si...)
(mais comme c'est juste histoire d'aller dans VBE)

VB:

Sub Pour_Le_Fun_II_EtSeulement_pour_le_fun()
t = [{6, 31, 9, 34, 12, 37, 15, 40, 20, 45, 25, 50}]
With Application
    .ScreenUpdating = False
     Rows("31:50").Hidden = 0: Rows(.Index(t, .Match([A1], t, 0) + 1) & ":50").Hidden = -1
End With
End Sub

Staple1600 · 1 Novembre 2020

Re

Vivement le re-déconfinement

VB:

Sub Hé_vous_la_bas_Si_ça_continue_Faudra_qu_ca_cesse_Agagagaga()
Set r = [AE5]
Rows("31:50").Hidden = 0
x = (r = 6) * 31 + (r = 9) * 34 + (r = 12) * 37 + (r = 15) * 40 + (r = 20) * 45 + (r = 25) * 50
Rows(-x & ":50").Hidden = -1
End Sub

mapomme · 1 Novembre 2020

Bonjour à tous,
J'aimerai bien connaitre la durée initiale et les durées de chaque code.
Même si gain il y a, à mon avis, c'est négligeable, non ?

soan · 1 Novembre 2020

@Staple1600 a écrit : « Vivement le re-déconfinement »

pourquoi ? pour être re-re-confiné ensuite ? et puis, on est qu'au début
du 2ème confinement ! si ça peut te consoler, et t'aider à relativiser, pense
qu'une femme enceinte en a pour 9 mois ! (c'est long, 9 mois !)

sérieusement, après la récession économique due au 1er confinement,
j'pensais qu'les politiciens ne feraient jamais un 2ème confinement !

ben j'm'étais bien trompé ! (mais au cas où, j'avais quand même
gardé mes anciennes attestations de sortie, juste par prudence ! je les ai donc
ressorties pour l'occasion...)

soan

mapomme · 1 Novembre 2020

Staple1600 à dit:
Sub Hé_vous_la_bas_Si_ça_continue_Faudra_qu_ca_cesse_Agagagaga()

Quelle est heure est-il ? 22h43 3 ?

soan · 1 Novembre 2020

@mapomme

j'suis trop débordé en c'moment, alors j'te laisse le soin d'chronométrer !

mais au fait, on est dimanche, aujourd'hui ! t'es pas parti à la pêche ?
ah non, c'est vrai, y'a pas d'autorisation d'sortie pour aller embêter
les poissons ! morale de la fable : les poissons adorent le
confinement : c'est scientifiquement prouvé !

----------------------------------------------------------------------------------

pour l'heure, avec le récent changement d'horaire, j'ai 16:55
(heure de Paris = heure française)

soan

Staple1600 · 1 Novembre 2020

Re

=>soan
Vivement le ré-deconfinement simplement pour qu'on arrête de lire mes inepties "vbaistiques" sur XLD

=>mapomme
je savais que tu saisirais l'allusion

mapomme · 1 Novembre 2020

soan à dit:
mais au fait, on est dimanche, aujourd'hui ! t'es pas parti à la pêche ?

j'ai changé de technique, confinement oblige. Comme les esquimaux de Gervais, je pêche maintenant sur les rayons gelés de mon congélateur. Hélas ! Je ne pêche que des cabillauds, espèce de poissons à coin carrés et rescapés de la pêche industrielle du capitaine Igloo.

XL 2019 Comment Accélérer cette macro

pat66

XLDnaute Impliqué

fanfan38

XLDnaute Barbatruc

Softmama

XLDnaute Accro

soan

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Discussions similaires