Suppression ligne conditions VBA

Version imprimable

20/08/2019, 19h25
chloe.secli

Suppression ligne conditions VBA

Bonjour à tous
Je suis bloquée depuis ce midi sur cette étape... :calim2:

Situation : j'ai une liste de référence (sur la feuille 2: Liste), je veux supprimer les lignes (feuille1:Données) qui ne contiennent pas les références qui sont dans ma liste. J'ai plus de 130 000 lignes sur mon vrai fichier.
(sur F1:H2 c'est le résultat que je voudrais obtenir automatiquement)

Méthode:
Soit on supprime les lignes directement sur le tableau, soit on créait une nouvelle feuille où l'on récupère que les lignes où la référence se trouve dans la liste. Je ne sais pas quelle méthode serait la plus facile à coder en VBA. Ou si vous avez une autre idée je suis preneuse

Pièce jointe 498590

Merci d'avance :)
Et bonne soirée :P

1 pièce(s) jointe(s)

Bonsoir,

En réponse à ta demande, essaye ce code en le copiant dans un module

Astuce logique : On filtre les données sur le résultat attendu, on le colle à la suite du tableau et on supprime le tableau précédent. Attention à la limite de 1 millions lignes sur les fichiers excel;

Code:

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
42
43
44
45
46
47
48
49
50
51
Sub Bouton1_Cliquer()
 
    Dim Feuille   As Worksheet ' Feuille contenant les données
    Dim Liste     As Range     ' Plage contenant les références dans la feuille liste
    Dim lColonne  As Long      ' Colonne contenant les références dans la feuille données
 
 
    'Plage des références
    Set Feuille = ThisWorkbook.Worksheets("Données")
    Set Liste = ThisWorkbook.Worksheets("Liste").Range("A2:A5")
 
    lColonne = 1
 
    Suppression Feuille, Liste, lColonne
 
 
End Sub
 
Sub Suppression(Feuille As Worksheet, Liste As Range, lColonne As Long)
 
    Dim Ref   As Range
    Dim Derlig As Long
    Dim Valeurs()
 
    Application.ScreenUpdating = False
 
    Valeurs = Application.Transpose(Liste)
    For i = LBound(Valeurs) To UBound(Valeurs)
        'obligation de convertir les valeurs au format texte
        Valeurs(i) = CStr(Valeurs(i))
    Next i
 
    With Feuille
 
        If .FilterMode Then .ShowAllData
 
        Derlig = .Cells(.Rows.Count, lColonne).End(xlUp).Row
 
        .Range("1:" & Derlig).AutoFilter lColonne, Valeurs, xlFilterValues
        .Range("2:" & Derlig).SpecialCells(xlCellTypeVisible).Copy .Range("A" & Derlig + 1)
 
        If .FilterMode Then .ShowAllData
        .Range("2:" & Derlig).Delete
 
        .Range("1:" & Derlig).AutoFilter ' Suppression du filtre
 
    End With
 
    Application.ScreenUpdating = True
 
End Sub

Avec le fichier Pièce jointe 498606

En espérant que cela te fera gagner du temps.

A+

Salut.

Je te propose une approche volontairement basique mais fonctionnelle qui, pour une utilisation épisodique, peut fonctionner (elle prend 15 secondes sur 150000 lignes avec une condition de suppression basique). Si tu dois l'utiliser toutes les heures, il sera préférable d'utiliser d'autres solutions plus rapides, notamment avec filtres et/ou tri, ou en passant par des tableaux VBA (arrays), mais qui sont peut-être un peu plus complexes...

C'est à toi de voir en fonction de la fréquence de nettoyage. La macro se base sur la colonne A pour déterminer les lignes à prendre en compte et la condition est que si la valeur de la cellule commence par "A", la ligne est supprimée. Tu remarqueras que l'on commence toujours la suppression des lignes par le bas du tableau en remontant. Il est également intéressant de désactiver l'affichage et le calcul automatique pour accélérer le traitement. C'est à toi à adapter à ton cas de figure et à ta (tes) condition(s) de suppression.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub DeleteRows() Dim r As Long On Error GoTo EndHandler Application.Calculation = xlCalculationManual Application.ScreenUpdating = False r = Range("a1048576").End(xlUp).Row Do While r > 0 If Left(Cells(r, 1).Value, 1) = "A" Then Cells(r, 1).EntireRow.Delete r = r - 1 Loop EndHandler: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True If Err <> 0 Then MsgBox Err.Description, vbOKOnly + vbExclamation, "Erreur " & Err.Number End Sub

21/08/2019, 08h50
Menhir

Sans VBA, dans les données à trier, tu ajoutes une colonne avec une fonction EQUIV() qui cherche l'item courant dans ta liste de référence.
Tu fais un tri de l'ensemble de la table en utilisant cette nouvelle colonne comme clé de tri.
Tu supprimes d'un bloc les lignes qui contiennent un code d'erreur dans cette colonne.

Montre en main, ça devrait te prendre moins d'une minute.
Pas très rentable de se lancer dans une macro pour si peu.
21/08/2019, 08h55
Pierre Fauconnier

Si c'est pour un one shot, effectivement, Excel est équipé pour cela.

Si la demande consiste à le faire par VBA, on peut supposer que c'est pour qu'il y ait répétition. Mais c'est vrai que parfois, le VBA est souhaité par méconnaissance des possibilités d'Excel.
21/08/2019, 09h23
chloe.secli

Merci à vous tous pour votre temps
En effet je ne connaissais pas cette fonction sur excel, ça m'a sauvé merci beaucoup!

Bonne journée à vous :D
21/08/2019, 10h15
MarcelG

Bonjour à vous, Bonjour au Forum,

Pour ma part, j'utilise la suppression d'un bloc des lignes indésirables en utilisant un objet Range issu de l'union des cellules concernées.
En effet, de la même manière que l'on peut écrire

Code:

n = n+1

On peut coder

Code:

Set P = Union(P,c)

Ici chaque objet Range c s'obtient en boucle par la méthode Find.

En fin de code

Code:

P.EntireRow.Delete
21/08/2019, 10h36
Menhir

Citation:

Envoyé par MarcelG

En effet, de la même manière que l'on peut écrire

Code:

n = n+1

On peut coder

Code:

Set P = Union(P,c)

Ici chaque objet Range c s'obtient en boucle par la méthode Find.

Il y a une petite différence : Union ne fonctionnera pas si la variable P contient Nothing qui est sa valeur par défaut.
Plus clairement, il faudra mettre dans P au moins une référence de cellule avant de pouvoir la placer dans une Union.

Donc, il faudra écrire quelque chose comme :

Code:

If P Is Nothing Then Set P = c Else Set P = Union(P, c)

Je suis déjà tombé dans le piège, c'est pour ça que je connais le problème.
21/08/2019, 10h44
MarcelG
Salut,

Tout à fait.
C'est ce que mon post sous-entendait.
Je n'ai pas été sans doute assez explicite.

Le processus serait le suivant

A la 1ère cellule trouvée

Code:

Set P = c

Ensuite, avec condition sur P

Code:

If Not P Is Nothing Then

par boucle sur c

Code:

Set P =Union(P,c)

Enfin,
Code:

1 2 P.EntireRow.Delete
Je n'avais pas reporté la condition qui pour moi s'imposait.
Mais mieux vaut être explicite pour nos collègues.
21/08/2019, 14h13
laurent_ott

Pas sûr que Union puisse gérer 1 million de lignes à supprimer. Ca reste à tester.
21/08/2019, 14h48
Menhir

Ce n'est pas Union qui gère l'ensemble des ligne mais la variable Range qu'elle renseigne.
Union ne fait qu'ajouter une ligne supplémentaire à cette variable Range.
21/08/2019, 14h50
MarcelG

(croisement avec Menhir, que je salue au passage)

Bonjour Laurent,

Dans l'absolu, je ne vois pas pourquoi.
Si l'on peut affecter une variable à 1 objet Range d'un million de cellules, pourquoi ne pas en envisager l'union dont on supprimerait les lignes.

Serait-ce une contrainte de mémoire et/ou de version Windows\Office?

Je ne sais pas.

Cela dit, le cas d'un million de lignes à supprimer ne devrait pas être si courant.
21/08/2019, 15h03
laurent_ott

Je pose la question car j'ai été confronté à cette contrainte de capacité mémoire d'EXCEL sur des traitements avec union.
je n'ai pas le matériel nécessaire sous la main aujourd'hui pour tester la procédure proposée, mais je me pose quand même la question.
Si vous avez 5 minutes à perdre, faites donc le test pour me rassurer.
Car je pense qu'il ne faudrait pas proposer une solution non valable dans certain cas (même rares) si une solution "universelle" existe.
Merci pour votre participation.

Salut,

Testé, approuvé....

Environnement : Excel 2016 (1 048 576 lignes, sauf erreur une puissance de 2)

Voir les résultats de contrôles indiqués dans le code.

Code:

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
42
43
44
45
46
Option Explicit
 
Sub test()
 
Call essai_lignes
Call essai_suppression
 
End Sub
 
Sub essai_lignes()
 
Dim i As Long
 
Application.ScreenUpdating = False
 
With Feuil1
        For i = 1 To .Rows.Count
                With .Cells(i, 1)
                        .Value = .Row * 2
                End With
        Next i
End With
 
End Sub
 
Sub essai_suppression()
 
Dim P As Range
Dim c As Range
 
With Feuil1
        Set P = .Range("A48577")
        For Each c In .Range("A48578:A" & .Rows.Count)
                With c
                        If .Row > 48577 Then
                                Set P = Union(P, c)
                        End If
                End With
        Next c
        Debug.Print P.Count 'Donne 1000000
        P.EntireRow.Delete
        Debug.Print .Cells(.Rows.Count, 1).End(xlUp).Row 'Donne 48576
        Set P = Nothing
End With
 
End Sub

21/08/2019, 16h04
laurent_ott

Merci Marcel pour ce test.
J'en ferais un autre demain en partant d'une autre approche, car dans ton cas les lignes mises dans Union sont "collées", donc un seul espace mémoire est utilisé.
Bref, dans mon test je vais utiliser1 million de lignes où en colonne "A" je mets une lettre comprise aléatoirement entre A et Z.
Puis je demande la suppression de tous les A.
En principe 1/26 de 1 million soit plusieurs milliers de lignes non collées à mémoriser et donc autant de mémoires pour Union.
Et je verrai si ça marche...
21/08/2019, 16h09
MarcelG

D'accord, Laurent.

En tout état de cause, reporte ton code, avant midi si possible.
Je testerai sur mon ordinateur.

J'ai fait les tests (voir code source joint) et j'ai une bonne et une mauvaise nouvelle.

La bonne nouvelle c'est qu'effectivement utiliser Union marche sans problème de mémoire (j'ai confondu avec le fait d'utiliser .Select sur un nombre important de cellules distinctes).

La mauvaise nouvelle c'est que cette méthode est très longue: sur une liste de 100 000 lignes contenant aléatoirement une lettre entre A et Z en colonne "A", supprimer les lignes qui contiennent la lettre A (environ 4000 lignes concernées) demande 8 secondes contre 2 avec la méthode de Pierre Fauconnier.
Et sur une liste de 500 000 lignes le temps de traitement est carrément déraisonnable en j'ai cru avoir fait planter ma machine : 885 secondes contre 57 avec la méthode de Pierre Fauconnier.
Du coup je n'ai pas testé sur une liste d'un million de lignes.

Je vous laisse tirer les conclusions de ces tests.

le code utilisé :
Code:

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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 Sub Tester() Dim T As Variant Range("A:A").Clear Call A_Z T = Timer Call SupprimerA Debug.Print "Durée avec Union : " & Timer - T Call A_Z T = Timer Call DeleteRows Debug.Print "Durée avec DeleteRows : " & Timer - T End Sub Sub A_Z() Dim i As Long For i = 1 To 500000 Cells(i, 1) = Chr(Rnd() * 25 + Asc("A")) Next i End Sub Sub SupprimerA() Dim P As Range Dim C As Range Application.Calculation = xlCalculationManual Application.ScreenUpdating = False For Each C In Range("A1:A500000") If C.Value = "A" Then If P Is Nothing Then Set P = C Else Set P = Union(P, C) End If Next C P.EntireRow.Delete Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Sub DeleteRows() Dim r As Long On Error GoTo EndHandler Application.Calculation = xlCalculationManual Application.ScreenUpdating = False r = Range("a1048576").End(xlUp).Row Do While r > 0 If Cells(r, 1).Value = "A" Then Cells(r, 1).EntireRow.Delete r = r - 1 Loop EndHandler: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True If Err <> 0 Then MsgBox Err.Description, vbOKOnly + vbExclamation, "Erreur " & Err.Number End Sub

22/08/2019, 13h04
MarcelG

Bonjour Laurent, Bonjour le Forum,

Laurent,

Mes excuses pour cette réponse tardive.
*
Sur mon poste, les temps de traitement de ton code sont respectivement 1027 s et 65 s.
J'ai tenté un essai en utilisant la méthode Find Même ordre de grandeur: 989 s.

A mon niveau de technicité, ce qui ne signifie pas grand-chose, je ne peux que te donner acte.
*
Reste à savoir pourquoi mon précédent code retourne une exécution immédiate - 7 s - pour 1 million de lignes, alors qu'il n'en est pas de même ici.

Juste pour information, si T désigne la valeur Timer, alors T peut être déclaré en Single.