XL 2019 Comment Accélérer cette macro

[pat66]

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]

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]

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]

Bonjour,

je propose ce petit bout de code VBA :

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]

Bonjour

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

bon we

Patrick

 

[pat66]

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]

Bonjour le fil

Juste parce que les minutes sont longues

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]

Re

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

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]

Re

Vivement le re-déconfinement

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]

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]

@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]

Sub Hé_vous_la_bas_Si_ça_continue_Faudra_qu_ca_cesse_Agagagaga()

Quelle est heure est-il ? 22h433 ?

 

[soan]

@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]

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]

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.