XL 2016 Optimisation d'une boucle

thivame

XLDnaute Junior
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
 

thivame

XLDnaute Junior
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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Barbatruc
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
 
Dernière édition:

thivame

XLDnaute Junior
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
 

thivame

XLDnaute Junior
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
 
Dernière édition:

ChTi160

XLDnaute Barbatruc
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
 

Pièces jointes

  • Test Clear.gif
    Test Clear.gif
    95.3 KB · Affichages: 6

thivame

XLDnaute Junior
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

XLDnaute Barbatruc
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
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 563
Messages
2 089 681
Membres
104 252
dernier inscrit
dbsromaric