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.

12passpass.xlsm (23.01 Ko)
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.

Rechercher des sujets similaires à "macro trop longue"