Discussion :

[Benoit Schwob]

Bonjour,

Dans une feuille, je veux limiter le contenu d'une table à une certaine sélection en y supprimant des lignes.

J'ai :
- une feuille contenant la table dont l'une des colonnes contient des numéros de référence (String). Il y a plusieurs milliers de lignes et le même numéro de référence peut apparaître n fois ;
- une variable tableau qui contient une sélection de numéros de référence, numéros qui se trouvent ou pas dans la feuille. Il peut y avoir quelques centaines d'items dans cette variable tableau.

Ma question : comment supprimer les lignes de la feuille pour ne garder que celles dont le numéro de référence fait partie de ceux listés dans la variable tableau ?

Je cherche à le faire intelligemment : boucler sur les lignes puis, dans chacune, boucler sur la variable tableau, c'est mortellement long puisque je vais avoir plusieurs centaines de milliers de tests, donc j'oublie.
(Au pire, je pourrais descendre la variable tableau dans une nouvelle feuille et insérer une RechercheV dans la base (par VBA) pour supprimer ensuite via un filtre, mais c'est beaucoup de code pour un truc pas forcément joli-joli, non ?)

La problématique ne doit pas être nouvelle mais je ne sais pas comment la formuler mieux que ça dont je ne sais pas où chercher...

Des idées ?
Merci !

Benoît

[mercatog]

Bonjour
Quelle est la version de ton Excel?
Peut être un filtre

[Benoit Schwob]

Bonsoir Mercatog,

Oups, j'ai oublié de préciser "Excel 2003".

Entre temps, j'ai trouvé une piste pas mal : j'utilise une feuille d'appoint dans laquelle je déverse les "bonnes lignes".
Concrètement :
- je crée cette feuille d'appoint et j'y recopie les étiquettes de la feuille de départ (Rows(1), simplement)
- je parcours uniquement les valeurs X de ma variable tableau, et dans chaque boucle :
--- je filtre la bonne colonne sur X,
--- je couvre les données filtrées via CurrentRegion et je les copie
--- je colle "en-dessous" dans ma feuille d'appoint.

J'ai l'impression (non chronométrée encore) que ça tourne assez vite.

Reste un problème de CurrentRegion :
- pour couvrir les données filtrées mais sans les étiquettes, je définis la plage comme ceci

Code :

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

Set maPlage = cellule.CurrentRegion

- puis j'en dégage les étiquettes par une intersection de cette plage avec cette même plage décalée

Code :

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

Set maPlage = Intersect (maPlage, maPlage.Offset(1, 0)

- sauf que, dans les cas où la valeur X ne se trouve pas dans la colonne en question et que le filtre ne retourne donc rien, la commande ci-dessus définit maPlage sur... CurrentRegion de toute la feuille !

Où est-ce qu'il y a un souci ?

Benoît

[mercatog]

Regarde du coté de

Code :

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

Range("A1:A100").SpecialCells(xlCellTypeVisible)

[Didier Gonard]

Bonjour,

Je raisonnerai à l’envers.

• Dans une copie de la feuille1, je fais un filtre Auto.
• Je récupère la liste des items (uniques par définition) de la colonne voulue => Array (variable tableau)
• Je compare mes 2 Arrays => Array3 résultant que le N°s de ref non voulus
• Je filtre la feuille 1 via les données Array3 en boucle en faisant sauter les résultats(lignes visibles).
  
• Je ne boucle en filtre que sur les données ciblées.
• Je ne fais qu’un seul copier coller (la feuille), puisque résultat = origine – suppression => vitesse et fiabilité.

cordialement,

Didier

Bonjour,

Autre possibilité, à chronométrer en temps global :

On se base sur le fait que si le nombre d'items de notre collection de référence augmente, c'est qu'une valeur non voulue a été trouvée => Ménage(s)...

Utiliser une collection de référence plutôt qu'un array avec un code du genre :

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
Option Explicit 'Didier Gonard 2011
 
Sub Menage()
Dim cell
Dim colPass As Collection
Dim lngMax As Long
Dim lngDerlign As Long
Dim I As Long
 
' sur une liste en colonne A de 20 items différents redondants sur 200 lignes
'les 14 premiers sont différents
Set colPass = New Collection
On Error Resume Next
For Each cell In Range("A1:A14")
'je crée ma collection de référence
    If cell <> "" Then colPass.Add cell, CStr(cell)
Next cell
'je procéde en parcourant une collection de cellule du bas en haut vu que je supprime des lignes...
lngDerlign = Range("A1").Offset(Rows.Count - 1, 0).End(xlUp).Row
lngMax = colPass.Count
' je note la limite sup de ma  collection de Ref
For I = lngDerlign To 1 Step -1
    With Cells(I, 1)
        If .Value <> "" Then
            colPass.Add .Value, CStr(Cells(I, 1))
            If colPass.Count > lngMax Then 'à cause du on error resume next
            'on refait un test, si un élément a été ajouté, ne nb d'items de la collection a augmenté => on traite
                Rows(.Row).Delete ' ménage feuille
                colPass.Remove (lngMax + 1) 'ménage collection
            End If
        End If
    End With
Next I
 
On Error GoTo 0
 
End Sub

cordialement,

Didier

[Benoit Schwob]

Bonjour,

Merci mercatog : la constante xlCellTypeVisible répond parfaitement à la question, c'est exactement ce que je voulais faire !
(Je ne la connaissais pas, tout bêtement, hum.)

Didier : le raisonnement est intéressant, merci pour le tuyau. Mais le hic c'est que les items de ma variable tableau ne représentent en général qu'une petite partie (de l'ordre du millième) des items de la table initiale.

Je retrouve le bout de code auquel j'ai abouti et je le collerai ici.

Bien cordialement,

Benoît (qui rejoint son fil une semaine plus tard…)

Pour info, voici le code auquel j'ai fini par aboutir. Au chrono, les délais sont très bien...

Mes variables fixées a priori sont les suivantes :

Code :

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

1
2
3
Public Ws1 As Worksheet         ' la feuille de base
Public Etiquette As String      ' l'étiquette de la colonne qu'on va filtrer
Public NumRéf()                 ' la variable tableau des références retenues

Avec ça, le raisonnement consiste à :
- créer une feuille d'appoint et y recopier les étiquettes de la feuille de base
- parcourir uniquement les valeurs de la variable tableau, et dans chaque boucle :
--- filtrer la feuille de base,
--- cadrer les données filtrées
--- les copier UNIQUEMENT si elles existent (grâce à la constante xlCellTypeVisible sur SpecialCells)
--- les coller "en-dessous" dans la feuille d'appoint.

Ce qui donne :

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
Private Sub AjusterPérimètre()
Dim Col As Integer      ' numéro de la colonne sur laquelle on va filtrer dans la feuille de base
Dim Plg As range        ' plages de données à transférer
Dim Ws2 As Worksheet    ' feuille-cible
Dim Cible As range      ' ciblage dans la feuille-cible pour collage des plages copiées
 
    ' la feuille de destination :
    Set Ws2 = Workbooks.Add             ' je la crée
    Ws.Rows(1).Copy Ws2.range("A1")     ' et j'y copie la ligne d'étiquettes de la feuille de base
 
    ' je repère la colonne sur laquelle on va filtrer dans la table de base
    Col = Ws.Rows(1).Find(Etiquette, LookAt:=xlWhole).Column
 
    ' filtres
    Dim i As Integer
    For i = LBound(NumRéf) To UBound(NumRéf)                ' boucle sur NumRéf
 
        ' la clé du truc c'est ce filtre
        Ws.range("A1").AutoFilter Field:=Col, Criteria1:="=" & NumRéf(i)
 
        ' je cadre d'abord le bloc entier des lignes filtrées (avec les étiquettes)
        Set Plg = Ws.range("A1").CurrentRegion
 
        ' puis je ne continue que s'il y a des données !
        '(c'est à dire s'il y a strictement plus qu'1 cellule visible dans la première colonne de la plage filtrée)
        If Plg.Columns(1).SpecialCells(xlVisible).Cells.Count > 1 Then
 
            ' je cadre sur l'intersection de la plage avec cette même plage décalée (pour enlever la ligne d'étiquettes)
            Set Plg = Intersect(Plg, Plg.Offset(1, 0))
 
            ' je cible dans la feuille de destination               ' en trois temps :
            Set Cible = Ws2.Cells(1, 1).SpecialCells(xlLastCell)    ' on prend LastCell
            Set Cible = Ws2.Cells(Cible.Row, 1)                     ' on rejoint la colonne 1
            Set Cible = Cible.Offset(1, 0)                          ' et on descend d'1 ligne
 
            ' et je transfère
            Plg.Copy Cible
 
        End If
 
    Next
 
    ' finition
    application.CutCopyMode = False
 
End Sub

Et hop !

Benoît