Discussion :

[anarchiste-mouton]

Bonsoir,

Je ne suis pas du tout un expert en vba, j'utilise principalement l'enregistreur de macro et après j'essaie de simplifier le code. Seulement là je me retrouve bloqué..

Voici ce que j'ai :

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
 
Sub Macro1()
 
Dim ext As Worksheet
 
 
Set ext = ThisWorkbook.Worksheets("Extraction")
 
 
' Mise en formes du tableau
 
    ext.ListObjects.Add(xlSrcRange, Range("$A$1:$D$3000"), , xlYes).Name = "Tableau2"
 
 
 
' Tri radical du tableau
    ext.ListObjects("Tableau2").Range.AutoFilter Field:=8, Criteria1:="=0", Operator:=xlOr, Criteria2:="=#N/A"
    ext.Range("Tableau2").SpecialCells(xlCellTypeVisible).Select
'Tout fonctionne jusqu'à la ligne qui suit
    Selection.EntireRow.Delete
    ext.ListObjects("Tableau2").Range.AutoFilter Field:=8
 
End Sub

Auriez-vous une idée pour contourner ce problème?

Cordialement

[Invité]

Bonjour,

Une piste peut-être dans ce message qui reste à adapter : vba-recherchev-puis-supprimer-ligne-entiere

[Theze]

Bonjour,

Une piste mais lis les commentaires 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
 
Sub Test()
 
    Dim Plage As Range
    Dim Critere1 As String
    Dim Critere2 As String
 
    With Worksheets("Extraction")
 
        Set Plage = .Range("A1:D3000")
        Critere1 = "=0"
        Critere2 = "=#N/A"
 
        'dans ton exemple, tu indique le champ 8 mais ta plage ne fait que 4 champs ?
        'ici, sur le 1er champ, adaptes :
        Plage.AutoFilter 1, Critere1, xlOr, Critere2
        .AutoFilter.Range.EntireRow.Delete
        Plage.AutoFilter
 
    End With
 
End Sub

J'ai fais le test sur une simple plage et pas sur un objet tableau, à toi d'adapter

[Theze]

Re,

J'ai creusé un peu et il est possible de supprimer les lignes visibles issues d'un filtrage (entêtes de colonnes avec !) mais le tableau doit être remis sous forme de simple plage :

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
 
Sub Test()
 
    Dim Tbl As ListObject
    Dim Plage As Range
    Dim Critere1 As String
    Dim Critere2 As String
 
    With Worksheets("Extraction")
 
        Set Tbl = .ListObjects("Tableau2")
 
        Set Plage = Tbl.Range
        Critere1 = "=0"
        Critere2 = "=#N/A"
 
        Tbl.Unlist '<--- supprime la fonction de liste sous forme de tableau, redevient sous forme de simple plage
 
        Plage.AutoFilter 1, Critere1, xlOr, Critere2
        .AutoFilter.Range.EntireRow.Delete
        Plage.AutoFilter
 
    End With
 
End Sub

[anarchiste-mouton]

Bonjour à vous et merci d'avoir pris le temps de me répondre.


J'ai repris le code de Theze mais il me fallait garder les entêtes, donc après bidouillage j'obtiens ç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
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Sub Macro1()
 
Dim res, ext As Worksheet
Dim Tbl As ListObject
Dim Plage As Range
Dim Critere1, Critere2 As String
 
Set res = ThisWorkbook.Worksheets("Résultat")
Set ext = ThisWorkbook.Worksheets("ExtractionIFF")
 
 
' Mise en formes du tableau (je montre pas tout mais effectivement le tableau doit avoir  8 colonnes)
    ext.ListObjects.Add(xlSrcRange, ext.Range("$A$1:$H$3000"), , xlYes).Name = "Tableau2"
 
 
' Tri radical du tableau
    ext.Range("Tableau2[#Headers]").Copy Destination:=res.Range("A6:H6")
With ext
 Set Tbl = .ListObjects("Tableau2")
 Set Plage = Tbl.Range
        Critere1 = "=0"
        Critere2 = "=#N/A"
    Tbl.Unlist
    Plage.AutoFilter 8, Critere1, xlOr, Critere2
    .AutoFilter.Range.EntireRow.Delete
    Plage.AutoFilter
End With
    ext.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    res.Range("A6:H6").Cut Destination:=ext.Range("A1:H1")
    ext.Range("A1:H1").AutoFilter
 
 
End Sub

Un grand merci, ça fonctionne parfaitement