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

[Anr1]

Bonjour Forum,

Ci-joint un fichier avec un programme VBA pour suppression des lignes de la Feuil1 si la valeur de la colonne" D" Feuil2 n'existe pas sur la colonne "L" Feuil1

Le programme marche très bien à l'aide de Mr @pierrejean

par contre ma base de donner contient 85000 ligne et le programme prendre bcp de temps et il supprime pas tous les lignes à la fois je clic 10 fois pour le bouton et a chaque fois le programme supprime des ligne jusque un moment ou il supprime tous les lignes.

Est ce que vous pouvez développer le programme pour qu’il soit plus rapide et efficace

Sub supp_lignes()

Application.ScreenUpdating = False
For n = 2 To Range("L" & Rows.Count).End(xlUp).Row
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

Merci bien

 

[dg62]

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

 

[Anr1]

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

 

[dg62]

re

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

 

[Anr1]

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?

 

[pierrejean]

Re

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

 

[Anr1]

Bonjour @pierrejean

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

Merci a vous @pierrejean @dg62

@+

 

[dg62]

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

 

[dg62]

Re

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

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

 

[Anr1]

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

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