Modification d'une macro qui supprime des lignes

Quincy

XLDnaute Occasionnel
Supporter XLD
Bonjour à tous

Dans une macro j'utilise la procédure suivante pour supprimer toutes les lignes qui ne correspondent pas à l'exercice demandé :


Dim Exercice As String

retour:
Saisie_exercice:

Exercice = InputBox("Veuillez saisir l'exercice budgétaire !", "Exercice budgétaire")


If IsNumeric(Exercice) Then

Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select

Dim I As Long
Dim Plage As Range

Set Plage = Range("B2:B" & Range("B2").End(xlDown).Row)

For I = Plage.Cells.Count To 1 Step -1
If Plage.Cells(I).Value <> Exercice Then
Plage.Cells(I).EntireRow.Delete
' Else

End If
Next
GoTo OK
End If
GoTo retour


Cette façon de faire marche très bien mais le problème c'est qu'elle dure un peu trop longtemps à mon goût car je traite entre 4000 et 8000 lignes. Ce que je souhaiterais c'est une modification de la macro pour dire :

"je selectionne toutes les lignes qui ne correspondent pas à l'exercice demandé et les supprime".

Si une solution pouvait m'être apportée, d'avance merci.

Quincy
 

Cousinhub

XLDnaute Barbatruc
Re : Modification d'une macro qui supprime des lignes

Bonjour,
essaie avec ce code :

Code:
Sub Macro3()
Application.ScreenUpdating = False
Exercice = InputBox("Veuillez saisir l'exercice budgétaire !", "Exercice budgétaire")
If IsNumeric(Exercice) Then
    Rows("1:1").Insert Shift:=xlDown
    Columns("D:D").Insert Shift:=xlToRight
    [D2].FormulaR1C1 = "=R[1]C[-2]<>" & Exercice & ""
    Range("B2:B" & [B65000].End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("D1:D2"), Unique:=False
    Range("B3:B" & [B65000].End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Rows("1:1").Delete Shift:=xlUp
    Columns("D:D").Delete Shift:=xlToLeft
    ActiveSheet.ShowAllData
End If
    Application.ScreenUpdating = True
End Sub

2,7 secondes sur un fichier de 6145 lignes, en supprimant 4096 lignes
 

Quincy

XLDnaute Occasionnel
Supporter XLD
Re : Modification d'une macro qui supprime des lignes

Bonjour bhbh

Ta macro marche nickel je l'ai testé avec mes données et elle traite mes lignes très rapidemment.

J'ai voulu la tester en pas à pas pour voir comment elle marchait mais j'ai pas trop compris (tu as inséré une 1ère ligne pour pouvoir faire un filtre ?).

Enfin l'important c'est que ça marche et je te remercie.

Cordialement.
Quincy
 

Cousinhub

XLDnaute Barbatruc
Re : Modification d'une macro qui supprime des lignes

Re-,
c'était pour moi...
Tu peux supprimer les deux lignes de code :

Code:
    Rows("1:1").Insert Shift:=xlDown
.....
.....
    Rows("1:1").Delete Shift:=xlUp

par contre, ne connaissant pas la structure de ton tableau, j'ai rajouté une colonne (D) pour insérer la formule du filtre.
Si tu n'as rien dans cette colonne, tu peux modifier le code par :

supprimer :

Code:
    Columns("D:D").Insert Shift:=xlToRight

et remplacer :

Code:
    Columns("D:D").Delete Shift:=xlToLeft

par :

Code:
    [D2].ClearContents
 

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 852
dernier inscrit
dthi16088