XL 2016 Optimisation d'une boucle

thivame · 7 Décembre 2023

Bonjour a vous,
J'ai créé une boucle dans un onglet afin de récupérer des informations et les mettre sur un autre onglet si ça rempli deux conditions.
Celle ci fonctionne mais est assez lente pour "seulement" 250 lignes.
A votre avis est il possible de l'optimiser ?

Private Sub CommandButton1_Click()

Sheets("les entrées").Range("a6:w500") = Clear

'Application.ScreenUpdating = False

'Application.EnableEvents = False

Dim nom As String

nom = Sheets("les entrées").Range("i1")

derniereligne = Sheets(nom).Cells(Rows.Count, 1).End(xlUp).Row

Sheets("les entrées").Range("a6:w500") = Clear

If Sheets("les entrées").Range("c3") <> "" And Sheets("les entrées").Range("f3") <> "" Then

MsgBox "il faut choisir : soit manifestation soit evenement"

Sheets("les entrées").Range("c3") = Clear

Sheets("les entrées").Range("f3") = Clear

Exit Sub

End If

For i = 5 To derniereligne

If Sheets(nom).Range("d" & i).Value = Sheets("les entrées").Range("C3").Value And Year(Sheets(nom).Range("F" & i)) = Sheets("les entrées").Range("l1") Then

Worksheets("les entrées").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Sheets(nom).Range("ab" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 1) = Sheets(nom).Range("c" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 2) = Sheets(nom).Range("b" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 3) = Sheets(nom).Range("e" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 4) = Sheets(nom).Range("d" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 5) = Sheets(nom).Range("w" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 6) = Sheets(nom).Range("f" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 7) = Sheets(nom).Range("h" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 8) = Sheets(nom).Range("j" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 9) = Sheets(nom).Range("l" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 10) = Sheets(nom).Range("n" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 11) = Sheets(nom).Range("p" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 12) = Sheets(nom).Range("r" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 13) = Sheets(nom).Range("t" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 14) = Sheets(nom).Range("v" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 15) = Sheets(nom).Range("g" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 16) = Sheets(nom).Range("z" & i).Value

Worksheets("les entrées").Range("b" & Rows.Count).End(xlUp).Offset(0, 18) = Sheets(nom).Range("af" & i).Value
End If

Next

'Application.ScreenUpdating = True

'Application.EnableEvents = True

End Sub

Merci par avance pour votre aide

sylvanu · 7 Décembre 2023

Bonjour Thivame,
Vous n'auriez pas le fichier test correspondant ?
Ce serait plus simple pour y mener des test comparatifs.

thivame · 7 Décembre 2023

Bonjour Sylvanu,
Malheureusement c'est pour le boulot a ma femme et il y a des données confidentielles..déjà moi je le fais un peu à l'aveugle...quand je ne suis pas chez moi ( et c'est le cas)... Une idée m'est venu qui pourtant coule de source...j'ai désactivé le calcul automatique le temps de la boucle...et j'ai gagné un temps considérable...mais si vous avez des idées pour faire du quasi instantané...je suis preneur..
Cordialement

sylvanu · 7 Décembre 2023

Un fichier test est un petit fichier représentatif et anonyme, en aucun cas le fichier de travail.
Donc, vraiment au pif :
1- Inhiber tout event au départ : Scrren Calculation, Events
2- Ne pas relire en feuille des cellules à chaque tour quand on peut l'éviter, donc par ex :

VB:

Entrée = Sheets("les entrées").Range("C3").Value
Année = Sheets("les entrées").Range("l1")

Et ensuite réutiliser ces variables.
3- Worksheets("les entrées").Range("B" & Rows.Count).End(xlUp) est recalculculer sur chaque ligne, c'est inutile, on peut gagner du temps avec :

Code:

With Worksheets("les entrées").Range("B" & Rows.Count).End(xlUp)
    ...
    ...
end with

Ce qui pourrait donner, sans garantie car non testé

Code:

Private Sub CommandButton1_Click()
Sheets("les entrées").Range("a6:w500") = Clear
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim nom As String
nom = Sheets("les entrées").Range("i1")
derniereligne = Sheets(nom).Cells(Rows.Count, 1).End(xlUp).Row
Sheets("les entrées").Range("a6:w500") = Clear
If Sheets("les entrées").Range("c3") <> "" And Sheets("les entrées").Range("f3") <> "" Then
    MsgBox "il faut choisir : soit manifestation soit evenement"
    Sheets("les entrées").Range("c3") = Clear
    Sheets("les entrées").Range("f3") = Clear
    Exit Sub
End If
Entrée = Sheets("les entrées").Range("C3").Value
Année = Sheets("les entrées").Range("l1")
For i = 5 To derniereligne
    If Sheets(nom).Range("d" & i).Value = Entrée And Year(Sheets(nom).Range("F" & i)) = Année Then
        With Worksheets("les entrées").Range("B" & Rows.Count).End(xlUp)
            .Offset(1, 0) = Sheets(nom).Range("ab" & i).Value
            .Offset(0, 1) = Sheets(nom).Range("c" & i).Value
            .Offset(0, 2) = Sheets(nom).Range("b" & i).Value
            .Offset(0, 3) = Sheets(nom).Range("e" & i).Value
            .Offset(0, 4) = Sheets(nom).Range("d" & i).Value
            .Offset(0, 5) = Sheets(nom).Range("w" & i).Value
            .Offset(0, 6) = Sheets(nom).Range("f" & i).Value
            .Offset(0, 7) = Sheets(nom).Range("h" & i).Value
            .Offset(0, 8) = Sheets(nom).Range("j" & i).Value
            .Offset(0, 9) = Sheets(nom).Range("l" & i).Value
            .Offset(0, 10) = Sheets(nom).Range("n" & i).Value
            .Offset(0, 11) = Sheets(nom).Range("p" & i).Value
            .Offset(0, 12) = Sheets(nom).Range("r" & i).Value
            .Offset(0, 13) = Sheets(nom).Range("t" & i).Value
            .Offset(0, 14) = Sheets(nom).Range("v" & i).Value
            .Offset(0, 15) = Sheets(nom).Range("g" & i).Value
            .End(xlUp).Offset(0, 16) = Sheets(nom).Range("z" & i).Value
            .End(xlUp).Offset(0, 18) = Sheets(nom).Range("af" & i).Value
        End With
    End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

ChTi160 · 7 Décembre 2023

Bonsoir le Fil
sans fichier ne pourrai rien faire Lol
il est Toujours possible de faire un Fichier de ce que l'on a et ce que l'on veut ! Quelques lignes de données fictives suffisent ;
Question :
Que dois faire ?

VB:

Sheets("les entrées").Range("a6:w500") = Clear

Chez-moi cette Ligne testée renvoie une erreur ?????
et pourquoi la trouve t'on deux fois dans les 8 premières lignes de la procédure ?
Jean marie

thivame · 7 Décembre 2023

bonsoir,
@ChTi160: effectivement le fait que l'on trouve cette ligne deux fois est une erreur que j'ai corrigée il y a quelques minutes... mais chez moi cette ligne fonctionne.
@sylvanu: c'est exactement ca ) .. et nos deux codes mettent le même temps.. donc j'en déduis que c'est ce calcule qui ralentit a fond l'exécution.. pourtant c'est juste des soustractions ..
Merci pour tout

ChTi160 · 7 Décembre 2023

Re
Donc y'a comme un problème lol
"Clear" appartient au code Vba
Est ce que chez toi , c'est une variable ?
Quel est le résultat de cette ligne sur la plage de cellules "a6:w500 ?

Jean marie

sylvanu · 7 Décembre 2023

Re,

ChTi160 à dit:
"Clear" appartient au code Vba

Ca, je l'avais pas vu !
Mais ce qui est bizarre, et que je n'aurais pas imaginé c'est que ça :

VB:

Sub Essai()
[A1] = Clear
End Sub

Ca marche. Ca à le même effet que [A1].Clear alors que cela devrait générer une erreur.
( Win10 XL2007 VBA6.3, peut être un problème de config )

ChTi160 · 7 Décembre 2023

Re sylvanu
Chez moi ça beug (W11 365) lol
Tu as essayé avec

VB:

Sheets("les entrées").Range("a6:w500") = Clear

Mais bon !
Bonne fin de soirée
Jean marie

sylvanu · 7 Décembre 2023

Re,

ChTi160 à dit:
Sheets("les entrées").Range("a6:w500") = Clear

Ca marche aussi.
Mais j'ai déjà remarqué que plus on progresse en version moins on devient permissif. Très surement lié à de la sécurité ou de l'architecture, 365 n'a plus grand chose à voir avec 2007.
Mais bon, quelque soit la version, ça reste un bug.
Bonne soirée.

thivame · 8 Décembre 2023

Bonjour messieurs, c'est étrange car avec 2016 j'ai toujours fait comme ça "...= Clear" et cela a toujours fonctionné...
Jean marie pour répondre à ta question non clear n'est pas une variable chez moi, lorsque le code s'exécute, cela efface le contenu des cellules désignées.
Cependant, chez moi le " .clear" me donne une erreur.
Je travaille sur excel 2016 avec w10 pro ou w11 pro
Cordialement

ChTi160 · 8 Décembre 2023

Bonjour le Fil
Une vidéo
Bonne Journée
Jean marie
Jean marie
Ps :
si je mets

VB:

Option Explicit
Dim Clear$
Sub test()
Sheets("Feuil1").Range("a1:a100") = Clear
End Sub

ça fonctionne Lol

thivame · 8 Décembre 2023

En fait j'ai fait une erreur en faisant le code ".clear",donc en réalité le = clear me supprime le contenu des cellules en gardant la mise en forme ( ce que je souhaite) et le .clear efface le contenu ET la mise en forme
Mais en aucun cas je déclare" clear " comme variable. peut être est ce du à la version 2016??
Cordialement

ChTi160 · 8 Décembre 2023

Re
As tu essayé

VB:

Sub test()
Sheets("Feuil1").Range("a1:a100").ClearContents
End Sub

D'ailleurs est ce que

VB:

 test()
Sheets("Feuil1").Range("a1:a100") = ClearContents
End Sub

ça fonctionne ?
Jean marie

ChTi160 · 8 Décembre 2023

Re
que veux tu dire

En fait j'ai fait une erreur en faisant le code ".clear"

jean marie

XL 2016 Optimisation d'une boucle

thivame

XLDnaute Junior

sylvanu

XLDnaute Barbatruc

thivame

XLDnaute Junior

sylvanu

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

thivame

XLDnaute Junior

ChTi160

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

thivame

XLDnaute Junior

ChTi160

XLDnaute Barbatruc

Pièces jointes

thivame

XLDnaute Junior

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Discussions similaires