Discussion :

[chloe.secli]

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

Situation : j'ai une liste de référence (sur la feuille 2: Liste), je veux supprimer les lignes (feuille1onné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

[John Mc Evee]

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 :

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
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 Essai.xlsm

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

A+

[Pierre Fauconnier]

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 :

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

[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.

[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.

[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

[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 :

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

n = n+1

On peut coder

Code :

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

Set P = Union(P,c)

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

En fin de code

Code :

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

P.EntireRow.Delete

[Menhir]

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

Code :

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

n = n+1

On peut coder

Code :

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

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 :

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

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.

[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 :

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

Set P = c

Ensuite, avec condition sur P

Code :

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

If Not P Is Nothing Then

par boucle sur c

Code :

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

Set P =Union(P,c)

Enfin,

Code :

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

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.

[laurent_ott]

Pas sûr que Union puisse gérer 1 million de lignes à supprimer. Ca reste à tester.

[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.

[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.

[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.

[MarcelG]

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 :

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

[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...

[MarcelG]

D'accord, Laurent.

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

[laurent_ott]

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 :

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

[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.