Boucle très lente pour supprimer des lignes

**Mycomer** · 13/01/2016, 09h23

Bonjour,

Je cherche à supprimer d'un tableau les lignes qui ne contiennent pas certaines données en colonne A.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
' défini le nombre de lignes
    Dim lastRowQBAS As Long
    lastRowQBAS = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    ' si Ax <> BAS ou HAUT ou BLOP ..... alors supprime ligne entière
    For LIGNE = 9 To lastRowQBAS
       If Range("A" & LIGNE).Text <> "BAS" And Range("A" & LIGNE).Text <> "BLOP" And Range("A" & LIGNE).Text <> "TRUC" And Range("A" & LIGNE).Text <> "HAUT" And Range("A" & LIGNE).Text <> "VRAI" And Range("A" & LIGNE).Text <> "FAUX" Then
           Range("A" & LIGNE).EntireRow.Delete
           LIGNE = LIGNE - 1 'sinon efface 1 résultat sur 2
       End If
    Next LIGNE

Le code marche mais est extrêmement long (tableau de plus de 10 000 lignes).
- y a-t-il un moyen de le rendre plus rapide ? (j'ai pensé à "for each", mais je n'ai pas su l'utiliser).
- peut-on simplifier la ligne "IF" du style "If Range("A" & LIGNE).Text <> "BAS" And "BLOP" And "TRUC" And ......" sans redonner le Range à chaque fois ?

Merci d'avance

**Marc-L** · 13/01/2016, 09h39

Bonjour,

c'est normal : c'est une boucle !

L'idéal étant les lignes à supprimer se suivant après un tri puis via un filtre (normal ou avancé)
pour n'afficher que les lignes à supprimer et enfin la suppression …

Autre voie : alimenter une variable tableau uniquement des éléments à conserver …

______________________________________________________________________________________________________
Je suis Paris, Charlie, …

**joe.levrai** · 13/01/2016, 09h47

Bonjour,

une autre piste :

- filtre avancé avec export dans une autre feuille des lignes ne contenant pas ces critères
- suppression de la feuille initiale

**el_slapper** · 13/01/2016, 09h54

as-tu appliqué les standards d'optimisation excel. Je cite les 2 qui te concernent(surtout le deuxième) :

Si quand vous exécutez une macro qui effectue automatiquement des modifications dans des cellules, vous constatez une lenteur étrange, c'est vraissemblablement parce que votre classeur contient de nombreuses formules, et à chaque changement quelconque d'une cellule, Excel recalcule tout. AUssi, il est sage de mettre avant toute macro l'instruction de blocage du recalcul automatique :
Application.Calculation = xlCalculationManual
Pensez à le remettre à automatique juste avant la fin de la macro :
Application.Calculation = xlCalculationAutomatic

Egalement pour des questions de vitesse d'exécution, il est conseillé de désactiver le rafraîchissement de l'écran avant la macro, et réactiver après :
Application.ScreenUpdating = False
' Faire plein de choses qui affectent le contenu des cellules
Application.ScreenUpdating = True

Si c'est encore trop lent, alors les solutions proposées ci-dessus par mes collègues sont bien plus efficaces encore(mais demandent plus de travail).

**joe.levrai** · 13/01/2016, 10h09

Re bonjour,

un petit exemple du filtre avancé, qu'il faut tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub FiltreAvance()
Dim FEUILLE_SOURCE As Worksheet
Dim NomFeuille As String
Dim Criteres()
 
' les critères
Criteres = Array("<>BAS", "<>HAUT", "<>FAUX", "<>BLOP", "<>TRUC", "<>VRAI")
 
' la feuille de depart : IL FAUT METTRE LE NOM REEL DE TA FEUILLE
Set FEUILLE_SOURCE = ThisWorkbook.Worksheets("LaFeuilleInitiale")
 
' stockage du nom de la feuille
NomFeuille = FEUILLE_SOURCE.Name
 
' ajout d'une feuille
With ThisWorkbook.Worksheets.Add
    ' recopie de l'en-tête de la colonne A
    .Cells(1, 1).Resize(1, UBound(Criteres) + 1).Value = FEUILLE_SOURCE.Cells(1, 1).Value
 
    ' recopie des critères
    .Cells(2, 1).Resize(1, UBound(Criteres) + 1).Value = Criteres
 
    ' export via filtre avancé
    FEUILLE_SOURCE.UsedRange.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False
 
    ' nettoyage de la zone des critères
    .Cells(1, 1).Resize(4, 1).EntireRow.Delete
 
    ' suppression de la feuille source
    Application.DisplayAlerts = False: FEUILLE_SOURCE.Delete: Application.DisplayAlerts = True
 
    ' écriture du nom initiale de la feuille
    .Name = NomFeuille
End With
 
End Sub

Ps : j'ai un petit doute pour les critères VRAI et FAUX, ça va peut être cafouiller entre String et Booleen, tu nous diras

**Philippe Tulliez** · 13/01/2016, 10h11

Bonjour,
Si tu souhaites supprimer des lignes d'une liste de données suivant conditions, je te suggère comme déjà proposé par Marc et Joe, la méthode AdvancedFilter (filtre avancé) voir exemple Supprimer des lignes suivant critères avec la méthode AdvancedFilter

**Mycomer** · 13/01/2016, 10h45

Merci pour vos réponses rapides.

Mon tableau vient en effet d'un classeur externe, mais j'ai bien pensé à supprimer toutes les formules (et j'ai galéré pour ne recopier que les lignes avec les valeurs voulues, je me suis rabattu sur la solution de la copie intégrale puis suppression du "non voulu")

Je teste vos méthodes prochainement, je vous tiens au courant.

**joe.levrai** · 13/01/2016, 10h49

J'ajoute que la méthode de Philippe est beaucoup moins gourmande que la mienne !

il filtre sur place et supprime les lignes visibles (= répondant au critère)
de mon côté, j'exporte dans une nouvelle feuille pour supprimer l'ancienne.

après, pour la rapidité d'exécution, ça va se jouer en dixièmes de secondes sur 10 000 lignes, mais ça a le mérite d'être quand même plus rapide.

puisqu'il faut que je trouve un truc intéressant à ma méthode (

), je dirais que l'export du résultat permet, si besoin, de conserver la feuille initiale si finalement tu ne veux plus supprimer mais uniquement récupérer les lignes voulues.

mais pour cela, il faudra :

- mettre en commentaire la partie du code qui supprime la feuille
- changer le nom de la nouvelle feuille

EDIT :
1) si tu n'as pas besoin de conserver les formules, tu peux les remplacer par leur valeur comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
With Workbooks("NomDuClasseur").Worksheets("NomDeLaFeuille").UsedRange
    .Value = .Value
End With

2) on peut tout à fait utiliser un filtre avancé (export ou sur place) sur un autre classeur que celui qui contient le code. Il suffit de préfixer [NOM DE FEUILLE].[PLAGE] par le nom du classeur (qui doit être ouvert en revanche)

**Klin89** · 16/01/2016, 21h44

Bonsoir à tous

Une suggestion avec la méthode SpecialCells.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Supprime()
Dim ref As String
    ref = Chr(34) & Join(Array("BAS", "HAUT", "FAUX", "BLOP", _
         "TRUC", "VRAI"), Chr(34) & "," & Chr(34)) & Chr(34)
    With Sheets("Feuil1")
        With .Range("a1", .Range("a" & Rows.Count).End(xlUp)).Offset(, 1)
            .Formula = "=if(or(a1={" & ref & "}),"""",1)"
            On Error Resume Next
            .SpecialCells(-4123, 1).EntireRow.Select  'sélectionne
            '.SpecialCells(-4123, 1).EntireRow.Delete 'supprime
        End With
        '.Columns("b").Delete
    End With
End Sub

Comme le souligne joe.levrai, les valeurs faux et vrai posent problème

klin89

**joe.levrai** · 16/01/2016, 21h49

Bonjour,

mais c'est que je ne dis pas que des bêtises parfois

et en passant par un Cstr() ça contourne pas la conversion implicite en booléen ?

**Philippe Tulliez** · 17/01/2016, 10h59

Bonjour,

Comme le souligne joe.levrai, les valeurs faux et vrai posent problème

Ce qui pose problème c'est de mélanger des valeurs qui ne sont pas de même type. VRAI et FAUX sont des valeurs logiques et pas des chaînes de caractères.
Pour s'en convaincre, il suffit de taper VRAI par exemple en cellule A2 et de placer cette formule en cellule B2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(A2="VRAI";"C'est ok";"Ce n'est pas ok")

Le texte renvoyé sera "Ce n'est pas ok"

Par contre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(A2=VRAI;"C'est ok";"Ce n'est pas ok")

ou encore

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(A2;"C'est ok";"Ce n'est pas ok")

renvoie bien ce que l'on attend comme résultat

**joe.levrai** · 17/01/2016, 14h17

Bonjour Philippe,

je suis pas entièrement d'accord avec toi, mais je peux me tromper.

FAUX et VRAI peuvent être une chaine de caractère, sinon on pourrait pas les écrire et les manipuler, par exemple avec les filtres automatiques ?
Le problème réel, c'est la conversion implicite qu'effectue VBA ?

peut importe si j'ai raison ou pas, ça m'a donné une idée pour contourner le problème ... voici une modification de ma proposition :

- le tableau des critères du filtre avancé ne contient plus VRAI et FAUX
- avant le traitement du filtre avancé, un filtre automatique va isoler les lignes en VRAI et FAUX, puis les supprimer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub FiltreAvance()
Dim FEUILLE_SOURCE As Worksheet
Dim NomFeuille As String
Dim Criteres(): Criteres = Array("<>BAS", "<>HAUT", "<>BLOP", "<>TRUC")
    ' la feuille de depart : IL FAUT METTRE LE NOM REEL DE TA FEUILLE
    Set FEUILLE_SOURCE = ThisWorkbook.Worksheets("Feuil1")
 
    With FEUILLE_SOURCE
        NomFeuille = .Name
 
        ' suppression des filtres automatiques s'il y en a
        If .AutoFilterMode = True Then .AutoFilterMode = False
 
        ' filtre automatique sur "FAUX" et "VRAI" en colonne A
        .Rows(1).AutoFilter 1, "FAUX", xlOr, "VRAI"
        On Error Resume Next
            ' Suppression des lignes (s'il y en a)
            .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0
 
        ' suppression des filtres automatiques
        .AutoFilterMode = False
    End With
 
    With ThisWorkbook.Worksheets.Add
        .Cells(1, 1).Resize(1, UBound(Criteres) + 1).Value = FEUILLE_SOURCE.Cells(1, 1).Value
        .Cells(2, 1).Resize(1, UBound(Criteres) + 1).Value = Criteres
        FEUILLE_SOURCE.UsedRange.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False
        .Cells(1, 1).Resize(4, 1).EntireRow.Delete
        Application.DisplayAlerts = False: FEUILLE_SOURCE.Delete: Application.DisplayAlerts = True
        .Name = NomFeuille
    End With
End Sub

**Philippe Tulliez** · 17/01/2016, 15h14

Bonjour Joe,

je suis pas entièrement d'accord avec toi, mais je peux me tromper.
FAUX et VRAI peuvent être une chaine de caractère, sinon on pourrait pas les écrire et les manipuler, par exemple avec les filtres automatiques ?

Et pourtant c'est vrai, VRAI et FAUX sont quoi que tu en dises une valeur booléenne et pas une chaîne de caractères. D'ailleurs un classeur en Excel français où se trouve une de ces valeurs verra automatiquement ces valeurs être traduite dans la version anglaise par TRUE ou FALSE

Le problème réel, c'est la conversion implicite qu'effectue VBA ?

VBA considère bien cette valeur comme booléenne de même qu'Excel
Avec Excel (toujours avec la valeur VRAI ou FAUX en A2 place :

en cellule B2 la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=ESTLOGIQUE(A2)

en cellule C2, la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=ESTTEXTE(A2)

et en cellule D2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=ESTNUM(A2)

Tu verras ce que ces fonctions te renvoient.

Prenons maintenant le code VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox TypeName(Range("A2").Value)

Si tu veux que VRAI ou FAUX soient considérés comme chaîne de caractères, il faut faire précéder la valeur par une apostrophe. Exactement la même chose qu'avec une valeur numérique.
A ce moment là, c'est considéré comme un String.

**joe.levrai** · 17/01/2016, 15h44

Ahhh, suffit de dire qu'on est pas d'accord, et tu nous sors toute la sauce.

super merci

j'ai trouvé comment te tirer des vers supplémentaires du nez

c'est propre, imparable, et comme toujours source d'apprentissage

MERCI

si j'écris TRUE et FALSE dans un classeur français, il passe bien en VRAI et FAUX par simple égalité/affectation de valeur entre deux Cellules

Exemple : j'écris TRUE en A1 et je veux le recopier en A2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A2").Value = Range("A1").Value

Résultat : en A2 est écrit "VRAI"

**Mycomer** · 19/01/2016, 17h46

Avant tout un énorme merci à vous tous pour m'aider comme ça (et je ne savais pas que je lançais un débat STRING/BOLEAN... surtout que comme vous l'avez deviné "BAS", "HAUT", "FAUX", "BLOP", "TRUC", "VRAI" ne sont que des exemples. Désolé ^^) et vous m'avez fait peur quand j'ai essayé de comprendre les liens pour les filtres avancés.

Klin, l'idée de rajouter une colonne ne m'arrange pas mais Joe, j'adore ton code (je le comprends... presque). Pour vous 2, le coup de lister mes variables est parfait. Du coup, faut adapter.

On oublie VRAI et FAUX, mon tableau commence en ligne 8 (en-têtes) 9 et + (données) mais j'ai du mal à comprendre les valeurs .Cells (1 ,1) et .Resize (d'ailleurs resize quoi ? je veux rien resiz-er moi)

Et mon but étant d'avoir 4 copies de mon classeur en fonction des filtres appliqués, il faut bien que je garde le fichier d'origine pour en créer 4 nouveaux.

**joe.levrai** · 19/01/2016, 19h53

Bonjour,

Cells(1,1) fait référence à la cellule située en ligne 1 (premier chiffre) et colonne 1 (second chiffre)
Ca permet de travailler plus facilement sur les colonnes, que la méthode Range("A1")

La procédure que j'ai proposé part du principe que les en-têtes sont en ligne 1 et que les données commencent en colonne A ... mais ce n'est qu'un petit détail qui sera réglé à la prochaine proposition.

Resize est une méthode qui redimensionne une plage.

plutôt que d'écrire par exemple : Range(Range("A1"), Range("A100")) pour la plage allant de A1 à A100
on peut partir de A1 et le redimensionner de 100 lignes, et toujours sur une seule colonne : Cells(1,1).Resize(100,1)

Bon, le code va donc pouvoir être simplifié. En revanche, je n'ai pas compris pourquoi 4 copies sont à faire dans 4 nouveaux classeurs ?
Cela veut dire que tu as 4 critères et que chaque copie est l'extraction de toute la base, après suppression d'un seul critère ?
Tu peux expliciter un peu ta description ?

**Mycomer** · 19/01/2016, 22h03

Mon fichier est une extraction intégrale et j'ai besoin de créer 4 fichiers (pour 4 services) :
- service alphabet qui prendra les critères "A", "B" et "C"
- service numérique : "1", "2", "3"
- service geometrie : "carré", "rond", "triangle"
- service jaiplusdidée : "machin", "bidule", "truc"

(bien sur, c'est des exemples, on reprend les critères "bas", "haut"(.....) du message initial pour l'idée)

Chaque critère n'apparaissant que dans 1 seul service.

**joe.levrai** · 19/01/2016, 22h28

Ca devrait ressembler à ça, je n'ai pas testé, dis moi ce qu'il en est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub FiltreAvance()
Dim FEUILLE_SOURCE As Worksheet
Dim Criteres()
Dim NomFichier()
Dim i As Long
 
Criteres = Array(Array("<>A", "<>B", "<>C"), _
                 Array("<>1", "<>2", "<>3"), _
                 Array("<>carré", "<>rond", "<>triangle"), _
                 Array("<>machin", "<>bidule", "<>truc"))
 
NomFichier = Array("alphabet", _
                   "numérique", _
                   "geometrie", _
                   "jaiplusdidée")
 
 
' la feuille de depart : IL FAUT METTRE LE NOM REEL DE TA FEUILLE
Set FEUILLE_SOURCE = ThisWorkbook.Worksheets("LaFeuilleInitiale")
 
' pour chaque lot de critères (= pour chaque fichier à créer)
For i = LBound(Criteres) To UBound(Criteres)
    ' ouverture d'un nouveau classeur
    With Workbooks.Add
        ' sa première feuille
        With .Worksheets(1)
            ' écriture des en-têtes de la zone de critère
            .Cells(1, 1).Resize(1, UBound(Criteres(i)) + 1).Value = FEUILLE_SOURCE.Cells(8, 1).Value
            ' écritures des valeurs de critères
            .Cells(2, 1).Resize(1, UBound(Criteres(i)) + 1).Value = Criteres(i)
            FEUILLE_SOURCE.Cells(8,1).CurrentRegion.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False
            .Cells(1, 1).Resize(3, 1).EntireRow.Delete
            .Name = NomFichier(i)
        End With
 
        .SaveAs ThisWorkbook.Path & "\" & NomFichier(i) & ".xlsx", xlOpenXMLWorkbook
        .Close True
    End With
Next i
 
End Sub

l'enregistrement des classeurs se font dans le même dossier que celui où est le classeur contenant la procédure
format .xlsx

les valeurs à exclure peuvent provenir de plages excel, là c'est directement mis dans la procédure
n'est pas géré ici le cas où le fichier existe déjà : tu devrais avoir un message te demandant si tu veux écraser ou non

EDIT : j'avais oublié de modifier la position décalée de tes données (à partir de A8 pour les en-têtes)

**patricktoulon** · 19/01/2016, 23h07

Envoyé par Mycomer

Bonjour,

Je cherche à supprimer d'un tableau les lignes qui ne contiennent pas certaines données en colonne A.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Base 1
Sub TEST()
    Dim TABLO,virg,ias long,ro ,row_a_sup
    With ActiveSheet
        TABLO = .Range(.Cells(9, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
                For i = 1 To UBound(TABLO)
           ro = i + 8
           virg = IIf(i > 1, ",", "")
                      Select Case TABLO(i, 1)
            Case "BAS", "TRUC", "BLOP", False, True
            row_a_sup = row_a_sup & virg & ro & ":" & ro
        End Select
        Next
    .Range(row_a_sup).Delete Shift:=xlUp
    End With
End Sub

**joe.levrai** · 19/01/2016, 23h31

Salut patrick

mon dieu, une boucle ??? t'as pas honte ? Et pourquoi autant de ligne de code
la même svp, sans boucle et en prenant en compte les demandes qui se sont ajoutées

tes string déclarés en variant didjou ?

c'est plus de l'indentation là, c'est de l'édentation

le travail sur un activesheet

(ouais, ça fait longtemps que je t'ai pas taquiné, j'en profite

, tes codes m'ont manqué durant ces quelques mois d'absence

)

Boucle très lente pour supprimer des lignes [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager