[VBA] Accélérer une boucle

Le 17/03/2015 à 12:37

Bonjour,

Je travaille sur la macro suivante :

Sub Suppression_lignes_vides()

Application.ScreenUpdating = False

Range("L9").Select
 Do While ActiveCell <> ""
 If ActiveCell = 0 Or ActiveCell = "-" Then
 ActiveCell.EntireRow.Delete
 Else
 ActiveCell.Offset(1, 0).Select
 End If
 Loop

End Sub

Elle sert à supprimer les lignes de la colonne L qui contienne un zéro ou un tiret (à partir de la ligne 9). Cependant, elle doit traiter un certain nombre de lignes (environ 90 000) et est donc très longue (se compte en dizaine de minutes).

J'ai cherché en ajoutant un ScreenUpdating False, mais cela ne fait pas une différence énorme.

Avez-vous une solution pour ce genre de problème ?

Merci d'avance !

Le 17/03/2015 à 12:54

Bonjour

essaie déjà comme ceci

Sub Suppression_lignes_vides()
With ActiveSheet
    For i = .Range("L" & .Rows.Count).End(xlUp).Row To 9 Step -1
        If .Range("L" & i) = 0 Or Range("L" & i) = "-" Then Rows(i).Delete
    Next i
End With
End sub

A te relire

Le 17/03/2015 à 13:31

Merci de la réponse rapide !

J'ai essayé le code, la macro tourne et finit par planter Excel

Le 17/03/2015 à 13:35

Bonjour, bonjour !

Pour accélérer une boucle, rien de plus rapide que de ne pas l'utiliser ‼ Quand c'est évidemment possible …

Et ici c'est le cas : boucle inutile en utilisant un filtre !

Le 17/03/2015 à 13:50

L'idée est d'automatiser un fichier pour qu'un opérationnel ne connaissant rien à Excel puisse l'utiliser... Du coup, ça enlève l'idée du filtre au profit d'un bouton sur lequel on clique et qui fait tout le travail ! L'opérateur n'a plus qu'à imprimer et faire son boulot en somme D'où la nécessité de la macro, sinon effectivement j'aurai utilisé un filtre

Le 17/03/2015 à 13:55

Rien n'empêche d'utiliser un filtre provisoire dans un code ‼

Mais si tu préfères une usine à gaz lente via une boucle, à ta guise …

Le 17/03/2015 à 14:02

D'où le sujet de mon message afin de déterminer une solution à ce problème

Je ne pense pas avoir été la seule à être confrontée au problème et à chercher une solution

Le 17/03/2015 à 14:20

Et un bouton peut actionner un filtre ! ce qui met tout le monde d'accord = on utilise la performance d'excel et on pseudo-automatise une tâche (somme toute assez simple)

Le 17/03/2015 à 16:38

Bonjour à un tous,

un exemple avec filtre en ligne 1 et colonne à tester = B :

Private Sub CommandButton1_Click()
    [A1].AutoFilter Field:=2, Criteria1:="0", Criteria2:="-", Operator:=xlOr
    Rows(2).Resize(Cells(Rows.Count, 2).End(xlUp).Row).Delete Shift:=xlUp
    [A1].AutoFilter Field:=2
End Sub

eric

58classeur1.zip (8.69 Ko)
Le 17/03/2015 à 16:51

re

Evident que le filtre est plus rapide dans l'exécution du code ...

Sans fichier pas facile de proposer d'où le code par boucle afin de tester si on gagne du temps. Par contre le plantage m'étonne.

Le 17/03/2015 à 17:46

Je n'avais pas compris qu'il s'agissait aussi de supprimer des lignes.

Alors il y a encore plus rapide que le filtre : il faut trier sur le critère de suppression, chercher la première et la dernière occurrence et supprimer en bloc. On peut ensuite rétablir le tri d'origine.

Le 17/03/2015 à 18:50

Alors, y a t'il plus rapide ?

https://www.cjoint.com/c/ECrtbNVYHAw

Pour simplifier (c'est une démo), j'ai mis plus de 90.000 lignes, la colonne L contient des nombres au hasard de 0 à 9, et je supprime les lignes avec un "2", puis je rétablis l'ordre des lignes en considérant qu'elles étaient triées sur la colonne 1. Et puis je commence ligne 2 et pas 9.

edit, j'ai dû en supprimer une de trop d'ailleurs ... j'aurais du mettre :

    Rows(Sheets("Feuil2").Range("B2") & ":" & (Sheets("Feuil2").Range("B3") - 1)).Select
    Selection.Delete Shift:=xlUp
Le 17/03/2015 à 19:05

Oui, supprimer un bloc unique est beaucoup plus rapide que d'en supprimer de nombreux plus petits.

eric

Le 18/03/2015 à 09:15
eriiic a écrit :

Bonjour à un tous,

un exemple avec filtre en ligne 1 et colonne à tester = B :

Private Sub CommandButton1_Click()
    [A1].AutoFilter Field:=2, Criteria1:="0", Criteria2:="-", Operator:=xlOr
    Rows(2).Resize(Cells(Rows.Count, 2).End(xlUp).Row).Delete Shift:=xlUp
    [A1].AutoFilter Field:=2
End Sub

eric

Merci pour ta proposition, ça marche très bien ! Quelques latences encore, mais vu que la base de données à traiter est immense. Parfait pour plus petit

Steelson a écrit :

Alors, y a t'il plus rapide ?

https://www.cjoint.com/c/ECrtbNVYHAw

Pour simplifier (c'est une démo), j'ai mis plus de 90.000 lignes, la colonne L contient des nombres au hasard de 0 à 9, et je supprime les lignes avec un "2", puis je rétablis l'ordre des lignes en considérant qu'elles étaient triées sur la colonne 1. Et puis je commence ligne 2 et pas 9.

edit, j'ai dû en supprimer une de trop d'ailleurs ... j'aurais du mettre :

    Rows(Sheets("Feuil2").Range("B2") & ":" & (Sheets("Feuil2").Range("B3") - 1)).Select
    Selection.Delete Shift:=xlUp

C'est LA solution parfaite !!! Tout marche, et c'est super fluide (même pas le temps de cligner des yeux que c'est déjà fini !)

Voici le code final prenant en compte les deux paramètres de tri :

Sub Suppression_lignes_Proposition_du_Forum()

' Macro servant à supprimer les lignes dont les montants sont à 0 et les lignes erronnées avec des -
' Solution trouvée à partir du forum Excel-Pratique via les différentes propositions : http://forum.excel-pratique.com/excel/accelerer-une-boucle-t62158.html

'Suppression des lignes à 0

        derligne = Range("A1").End(xlDown).Row

    'Déterminer la plage de données sur laquelle le code va s'exécuter
        Columns("A:T").Select
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Add Key:=Range( _
            "L2:L" & derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("BDD à trier").Sort
            .SetRange Range("A1:T" & derligne)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    'Prise en compte du critère de suppression numéro 1

        Rows(Sheets("Paramètres de tri").Range("B2") & ":" & Sheets("Paramètres de tri").Range("B3")).Select
        Selection.Delete Shift:=xlUp

        derligne = Range("A1").End(xlDown).Row      'Détermine le nombre de lignes maxi sur lequel les tris vont s'effectuer

        Columns("A:T").Select
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Add Key:=Range( _
            "A2:A" & derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("BDD à trier").Sort
            .SetRange Range("A1:T" & derligne)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

'Suppression des lignes avec des tirets pour montant

        derligne = Range("A1").End(xlDown).Row

    'Déterminer la plage de données sur laquelle le code va s'exécuter
        Columns("A:T").Select
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Add Key:=Range( _
            "L2:L" & derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("BDD à trier").Sort
            .SetRange Range("A1:T" & derligne)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    'Prise en compte du critère de suppression numéro 1

        Rows(Sheets("Paramètres de tri").Range("B7") & ":" & Sheets("Paramètres de tri").Range("B8")).Select
        Selection.Delete Shift:=xlUp

        derligne = Range("A1").End(xlDown).Row      'Détermine le nombre de lignes maxi sur lequel les tris vont s'effectuer

        Columns("A:T").Select
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("BDD à trier").Sort.SortFields.Add Key:=Range( _
            "A2:A" & derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("BDD à trier").Sort
            .SetRange Range("A1:T" & derligne)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

End Sub

Un grand MERCI à tous pour le temps passé et pour les différentes propositions !

Le 18/03/2015 à 13:43

re

On aurait pu simplifier encore le code ...

Si terminé, veille à cloturer le fil en cliquant sur le V vert à coté du bouton EDITER

Cordialement

Rechercher des sujets similaires à "vba accelerer boucle"