Macro trop longue
Bonjour,
J'au une macro qui ne semble pas compliquée en soit mais qui me prend 7 secondes à s'effectuer.
Il s'agit de vérifier le contenu de la colonne "D" et de rendre cette ligne visible si elle contient une donnée.
Pourriez-vous m'orienter sur un code plus rapide svp?
Application.ScreenUpdating = False
t = Timer
Range("D39:D100").RowHeight = 0
For i = 100 To 39 Step -1
If Range("D" & i) = Range("G34") Then
Range("D" & i).RowHeight = 15
Else
Range("D" & i).RowHeight = 0
End If
Next i
MsgBox Timer - t & "lignes"
Merci
bonjour
sur mon ordi qui est loin d’être une bête de course ce code s’exécute très vite, à voir si tu n'aurais pas un conflit avec une macro évènementielle.
sinon, j'ai simplifié ton code, teste pour voir si c'est plus rapide.
Application.ScreenUpdating = False
t = Timer
For i = 100 To 39 Step -1
Range("D" & i).EntireRow.Hidden = Not Range("D" & i) = Range("G34")
Next i
MsgBox Timer - t & "lignes"
a plus
Oui merci pour la simplification du code.
Par contre c'est toujours aussi long. Je ne vois pas pourquoi.
Au cas où, je joins la totalité du code.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("D35,G34")) Is Nothing Then
mat = Range("G34")
Sheets(1).Range("Z4:AB180").Copy
Sheets("stat").Range("G39").PasteSpecial Paste:=xlPasteValues
Dim pl As Range
'_________________________________________________________________________Boucle des couleurs de graphique
Z = Timer
For Each pl In Range("G39" & ":I" & Range("G65536").End(xlUp).Row)
'lg = Range("G" & Range("G65536").End(xlUp).Row).Row - 39
i = pl.Row
If pl = "" Then
pl = ""
Else
With pl
.Characters(1, 2).Font.ColorIndex = 1
.Characters(3, 1).Font.ColorIndex = 30
.Characters(4, 1).Font.ColorIndex = 53
.Characters(5, 2).Font.ColorIndex = 3
.Characters(7, 2).Font.ColorIndex = 46
.Characters(9, 2).Font.ColorIndex = 45
.Characters(11, 2).Font.ColorIndex = 44
.Characters(13, 2).Font.ColorIndex = 12
.Characters(15, 2).Font.ColorIndex = 10
.Characters(17, 2).Font.ColorIndex = 43
.Characters(19, 2).Font.ColorIndex = 4
End With
End If
Next
MsgBox Timer - Z & "boucle couleur"
'________________________________________________________________________Cacher les lignes à 0
t = Timer
Range("D39:D100").RowHeight = 0
For i = 100 To 39 Step -1
Range("D" & i).EntireRow.Hidden = Not Range("D" & i) = Range("G34")
Next i
MsgBox Timer - t & "lignes"
'_______________________________________________________________________Décaler les connecteurs de X cm par rapport à la colonne et la moyenne
On Error Resume Next
f = Timer
'Période 1
coef = (Range("H6").Left - Range("G6").Left) / 20
i = Range("G32") * coef
ActiveSheet.Shapes.Range("Connecteur droit 4").Left = Range("G32").Left + i
' Période 2
coef = ([I6].Left - [H6].Left) / 20
i = [H32] * coef
ActiveSheet.Shapes.Range("Connecteur droit 8").Left = Range("H32").Left + i
'Périod 3
coef = ([J6].Left - [I6].Left) / 20
i = [I32] * coef
ActiveSheet.Shapes.Range("Connecteur droit 9").Left = Range("I32").Left + i
MsgBox Timer - f & "calcul connecteurs"
'_______________________________________________________________________Trouver la longueur des connecteurs
lg1 = Range("G" & Range("G65536").End(xlUp).Row).Row - 31
lg2 = Range("G" & Range("H65536").End(xlUp).Row).Row - 31
lg3 = Range("G" & Range("I65536").End(xlUp).Row).Row - 31
ActiveSheet.Shapes.Range("Connecteur droit 4").Height = lg1 * 15
ActiveSheet.Shapes.Range("Connecteur droit 8").Height = lg2 * 15
ActiveSheet.Shapes.Range("Connecteur droit 9").Height = lg3 * 15
End If
Range("D35").Select
End Sub
Bonjour,
Pour le fun : 0,03 seconde (dont 0,01 appui commande).
Cdlt.
Public Sub Masquer_lignes()
Dim i As Byte, t As Single
Application.ScreenUpdating = False
t = Timer
For i = 39 To 100
Range("D" & i).EntireRow.Hidden = Not Range("D" & i) = Range("G34")
Next i
MsgBox "temps écoulé : " & Format(Timer - t, "0.00") & " seconde(s)"
End Sub
Bonjour,
Je me doute que cette macro devrait être rapide mais non...
Je joins le fichier en entier. Peut être est-ce du au fait que ce soit dans une feuille en "Worksheet.Change"
La macro a étudier est dans la feuille 9 (stat)
Merci de votre aide
Edit: Cellule à modifier en D35 par liste déroulante "intuitive".
Mettre comme "nom" la ou les 1ère lettres du prénom de la classe "terminale" puis utiliser la liste déroulante
Bonjour
Une idée : le fichier contenant beaucoup de formule, une méthode consiste à stopper temporairement la mise à jour des cellules
=> instruction : Application.Calculation
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range
If Not Application.Intersect(Target, Range("D35,G34")) Is Nothing Then
Application.ScreenUpdating = False
Application.Calculation = xlManual
mat = Range("G34")
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End If
Range("D35").Select
End Sub
Cordialement
salut
c'est bien ce que je pensais tu as un conflit avec ta macro.
tu utilises une évènementielle change, celle ci se déclenche dès une modification de la feuille. donc elle se déclenche à chaque fois et fini par tourner en boucle.
pour éviter ceci, 2 méthodes :
-utiliser un boolean en début de code pour autoriser la macro à se relancer ou non, pas simple à mettre en place, mais efficace;
- utiliser application.enableevents, qui gèle les macros événementielles (à mettre en true en début de code puis false en fin de code.
mise en place rapide mais dangereuse, car le code risque de bugger si tu fais intervenir une autre évènementielle.
a plus
Bonjour et merci pour ces réponses.
Je ne connais pas trop le type "boolean" et ne peux pas me risquer à mettre une ligne de code qui pourrait faire buger la macro par application.enableevents (Je ne maitrise pas trop..) d'autant plus que le fichier n'est pas pour moi.
J'ai mis ceci qui augmente considérablement la rapidité: If Len(Target) < 2 Then
Je regarderai par contre les 2 idées qui semblent intéressantes.
Merci.
Edit: Pour Dixit: J'avais essayer de mettre le calcul en manuel mais sans résultat.