XL 2013 Développement d'un programme "VBA" pour suppression des lignes avec une seul condition

dg62

XLDnaute Barbatruc

• 28 Juin 2019

• #2

Bonjour Anouarlaciri

Pour supprimer les lignes en une seule passe il faut démarrer du bas.

For n = Range("L" & Rows.Count).End(xlUp).Row to 2 step -1

 

Vote positif 0 Vote négatif

A

Anr1

XLDnaute Occasionnel

Supporter XLD

• 28 Juin 2019

• #3

Bonjour @dg62,

Merci pour ta réactivité
J'ai pas bien compris votre message dsl

Est ce que vous pouvez m’écrire le programme ou joint un fichier ? svp

 

Vote positif 0 Vote négatif

dg62

XLDnaute Barbatruc

• 28 Juin 2019

• #4

re

VB:

Sub supp_lignes()

Application.ScreenUpdating = False
For n = Range("L" & Rows.Count).End(xlUp).Row to 2 step -1 ' on commence par le bas ainsi toutes les lignes sont passées en revue au premier passage de la boucle
Set c = Sheets("Feuil2").Columns("D").Find(Range("L" & n), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then Rows(n).Delete
Next
Application.ScreenUpdating = True
End Sub

 

Vote positif 0 Vote négatif

A

Anr1

XLDnaute Occasionnel

Supporter XLD

• 28 Juin 2019

• #5

Merci @dg62,

Actuellement le programme est mieux il marche avec une seul passe mais il faut 4 minute c'est normale d'après vous?

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 28 Juin 2019

• #6

Re

dg62 a parfaitement raison j'avais oublié ce principe de base
Pour supprimer globalement voir si ceci va un peu plus vite

 

Pièces jointes

• Test (65).xlsm

  27.7 KB · Affichages: 9

Vote positif 0 Vote négatif

A

Anr1

XLDnaute Occasionnel

Supporter XLD

• 28 Juin 2019

• #7

Bonjour @pierrejean

Merci une autre fois pour ta réactivité
Le programme marche parfaitement bien et plus rapide

Merci a vous @pierrejean @dg62

@+

 

Vote positif 0 Vote négatif

dg62

XLDnaute Barbatruc

• 28 Juin 2019

• #8

essayez cette procédure

Sub supp_lignes()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For n = Range("L" & Rows.Count).End(xlUp).Row to 2 step -1 ' on commence par le bas ainsi toutes les lignes sont passées en revue au premier passage de la boucle
Set c = Sheets("Feuil2").Columns("D").Find(Range("L" & n), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then Rows(n).Delete
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

Vote positif 0 Vote négatif

dg62

XLDnaute Barbatruc

• 28 Juin 2019

• #9

pierrejean à dit:

Re

dg62 a parfaitement raison j'avais oublié ce principe de base
Pour supprimer globalement voir si ceci va un peu plus vite

Cliquez pour agrandir...

Bonjour PierreJean
j'avais oublié également ce principe il y a quelques jours.

 

Vote positif 0 Vote négatif

A

Anr1

XLDnaute Occasionnel

Supporter XLD

• 28 Juin 2019

• #10

@dg62
le programme de @pierrejean est bcp plus rapide voilà le programme :

VB:

Sub supp_lignes()
Dim zone As Range
Application.ScreenUpdating = False
For n = Range("L" & Rows.Count).End(xlUp).Row To 2 Step -1
 Set c = Sheets("Feuil2").Columns("D").Find(Range("L" & n), LookIn:=xlValues, lookat:=xlWhole)
 If c Is Nothing Then
    If zone Is Nothing Then
      Set zone = Rows(n)
    Else
      Set zone = Application.Union(zone, Rows(n))
    End If
 End If
Next
zone.Delete
Application.ScreenUpdating = True
End Sub

Merci

 

Vote positif 0 Vote négatif