Discussion :

[blepy]

Bonjour

On est souvent confrontés à ce genre de problème, la suppression de lignes dans un tableau Excel.
Quand nous avons 5 lignes tout va bien, mais supprimer 1000 lignes parmi 5000, c'est horriblement long.

Le code suivant est destiné à créer un nouveau classeur cloné mais en ayant supprimé les lignes non "intéressantes" sur le fichier d'origine.

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
Function Vidage_Clone()
    Application.ScreenUpdating = False
    Worksheets("Base").Activate
 
    Range("Sel_Clone_Base").Select
    K = Range("NbVal").Value
    For I = 1 To K + 3
    ActiveCell.Offset(1, 0).Activate
    If ActiveCell.Text = "#N/A" Then
        Selection.EntireRow.Delete
        ActiveCell.Offset(-1, 0).Activate
        End If
        Next I
    Application.ScreenUpdating = False
    End Function

Une proposition plus efficace de cette boucle interminable ?
Par avance milles mercis.

Bertrand

[Jean-Philippe André]

Bonjour,

une boucle decrementee sans activation =]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function Vidage_Clone()
    Application.ScreenUpdating = False
    Worksheets("Base").Activate
 
    Range("Sel_Clone_Base").Select
    K = Range("NbVal").Value
    For I = 5000 To 1 Step -1
 
        If Range("A" & i).Text = "#N/A" Then
            Range("A" & i).EntireRow.Delete
        End If
    Next I
    Application.ScreenUpdating = False
End Function

[vinc_bilb]

Bonjour: suggestions (très fortes):

1. Passer par les specialCells pour ne sortir que les erreurs
2. Filter sur la valeur recherchée et virer ce qui ressort, toujours en passant par les specialCells

Dans les deux cas, c'est très rapide (je n'ai pas mis les Application.ScreenUpdating) car on procède en une seule passe .....

Si ça peut contribuer ....

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
Sub DelErrLines()
 
Dim SrcR As Range
 
' Initialisation
    Set SrcR = ActiveSheet.Range("A1").CurrentRegion 'A Adapter
    Debug.Print SrcR.Address
 
' Solution 1
    Set SrcR = ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeFormulas, xlErrors)
    Debug.Print SrcR.Address
 
    SrcR.Delete
 
' Solution 2 (ici en utilisant un tableau: on filter et on vire le résultat du filtre)
    With ActiveSheet.ListObjects("Table2")
        .Range.AutoFilter Field:=3, Criteria1:="#VALUE!"   'A adapter
        Set SrcR = .DataBodyRange.SpecialCells(xlCellTypeVisible)
    End With
 
    Debug.Print SrcR.Address
    SrcR.Delete
 
End Sub

[blepy]

Merci pour vos réponses.

La boucle de Jean-Philippe marche et améliore mais n'est pas transcendante.

Je suis parti avec les propositions de vinc_bilb
et ai mis en œuvre cela :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function Vidage_Clone()
    Worksheets("Base").Activate
    Range("Sel_Clone_Base").Select  ' Ce nom indique la colonne sélection, si résultat = "N/A" je supprime
 
    LL = ActiveCell.Offset(1, 0)
    CC = ActiveCell.Column
    Nb = Range("NbVal").Value
 
    ActiveSheet.Range(Cells(LL, 1), Cells(LL, 1)).CurrentRegion.AutoFilter Field:=CC, Criteria1:="#N/A"
    Set SrcR = ActiveSheet.Range(Cells(LL, 1), Cells(LL + Nb - 1, 1)).SpecialCells(xlCellTypeVisible)
    SendKeys "{ENTER}", False
    SrcR.Delete
    ActiveSheet.ShowAllData

Je suis bloqué sur le SrcR.Delete qui me demande si je veux supprimer les lignes entières.
La réponse est bien évidemment Oui, mais le SendKeys n'a pas d'effet, je trouve peu de chose sur le SendKeys.

Une piste ?

Sinon, l'optimisation serait parfaite.

Bertrand

[blepy]

Je m'empresse de répondre à mon interrogation, car j'ai trouvé la solution :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function Vidage_Clone()
    Worksheets("Base").Activate
    Range("Sel_Clone_Base").Select  ' Ce nom indique la colonne sélection, si résultat = "N/A" je supprime
 
    LL = ActiveCell.Offset(1, 0).Row
    CC = ActiveCell.Column
    Nb = Range("NbVal").Value
 
    ActiveSheet.Range(Cells(LL, 1), Cells(LL, 1)).CurrentRegion.AutoFilter Field:=CC, Criteria1:="#N/A"
    Set SrcR = ActiveSheet.Range(Cells(LL, 1), Cells(LL + Nb - 1, 1)).SpecialCells(xlCellTypeVisible)
    'SendKeys "{ENTER}", False
    SrcR.EntireRow.Delete
    ActiveSheet.ShowAllData

En effet, il suffisait que je précise EntireRow au moment du Delete.

Merci beaucoup pour l'aide apportée.

Je positionne résolu

[Marc-L]

Bonjour blepy !

Rappel d'un post récent que tu as dû lire vu que tu as posté juste derrière !

Allégement d'une suppression de lignes parmi plusieurs lignes …

_________________________________________________________________________________________________________

Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …