SUPRESSION LIGNE rapidité d'execution

P

PASCAL84810

XLDnaute Junior
Bonjour,

j'ai repris et adapté une macro faite par un ancien collégue de travail, pour suprimer entierement une ligne suivant des conditions sur le texte d'une cellule mais j'ai 225000 Lignes à traiter et c'est super long. j'ai parcouru le site sur le sujet et fait des essais avec des macros proposé, mais je n'ai rien trouvé de concluant, existe-il une solution pour augmenter la rapidité d'exécution ? a part prendre un ordinateur plus puissant :D.

merci pour vos réponses

Sub suppressionlignegenerique()
Application.ScreenUpdating = False
Sheets("base de donnée").Activate

For i = Cells(1, 1).CurrentRegion.Rows.Count To 1 Step -1


If Cells(i, 1).Value = "TEXTE" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "PDR" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "ALARME" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "BALAI.ASPIRATEUR" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "COMPOSANT.ELECT.SAV" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "COUVERTURE.AUTO" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "COUVERTURE.HIVER" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "COUVERTURE.SOLAIRE" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "ELECTROLYSEUR" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVFC" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS1" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS1C" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS1F" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS2" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS2C" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS2F" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS3" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS3C" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS4" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS4C" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS4C" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "FSAVS4F" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "POMPE" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "POMPE.REGUL" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "ROBOT" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "SAV1" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "DIVERS" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "COUTKM1" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "PEAGE1" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 3) Like "COGAR*" Then Cells(i, 1).EntireRow.Delete

Next
Application.ScreenUpdating = True
End Sub
 
Trier par date Trier par votes
Efgé

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Bonjour PASCAL84810, Bonjour titiborregan5,
Une proposition, non testée faute de fichier exemple.
VB: 
Sub suppressionlignegenerique_2()
Dim i&, Tmp$, Liste$, LstRw&
Dim Plg As Range, Flag As Boolean

Liste = ",TEXTE,PDR,ALARME,BALAI.ASPIRATEUR,COMPOSANT.ELECT.SAV," & _
                "COUVERTURE.AUTO,COUVERTURE.HIVER,COUVERTURE.SOLAIRE," & _
                "ELECTROLYSEUR,FSAVFC,FSAVS1,FSAVS1C,FSAVS1F,FSAVS2," & _
                "FSAVS2C,FSAVS2F,FSAVS3,FSAVS3C,FSAVS4,FSAVS4C," & _
                "FSAVS4C,FSAVS4F,POMPE,POMPE.REGUL,ROBOT,SAV1," & _
                "DIVERS,COUTKM1,PEAGE1,"
                
Application.ScreenUpdating = False
With Sheets("base de donnée")
    LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plg = .Rows(i + 1)
    For i = LstRw To 1 Step -1
        Tmp = "," & .Cells(i, 1).Value & ","
        Flag = False
        If .Cells(i, 3) Like "COGAR*" Then
            Set Plg = Union(Plg, .Rows(i))
            Flag = True
        End If
        If Flag = False Then
            If InStr(Liste, Tmp) > 0 Then Set Plg = Union(Plg, .Rows(i))
        End If
    Next i
    If Not Plg Is Nothing Then Plg.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Re : SUPRESSION LIGNE rapidité d'execution

re bonjour,

Non, aprés plusieurs éssais, pas d'amélioration notable (7 à 8 minutes sur un fichier de 4500 lignes) . Par contre est-ce que le faite d'avoir 26 macros dans le workbook d'un classeur de 18 pages, peut ralentir les temps d'exécutions? je suis sur que sur une version antérieur avec moins de fichiers , de pages et de macros, cette macro était de quelques secondes pour le même nombre de ligne.


clt
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re
J'ai modifié ma proposition avec un nouveau code, je ne sais pas lequel tu as testé, mais si c'est le premier (avec dim Liste())
essai le nouveau, il pourrait être plus rapide.
Cordialement
 
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Re : SUPRESSION LIGNE rapidité d'execution

par contre, je ne comprend pas la macro, si je veux sur la même trame, couper et coller les lignes sur un autre feuille au lieu de les suprimer, comment je la modifie s'il te plait,

encore merci

cordialement
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re
Remplace
VB: 
f Not Plg Is Nothing Then Plg.EntireRow.Delete
Par
VB: 
If Not Plg Is Nothing Then Plg.EntireRow.Cut Sheets("Feuil2").Range("A1")
Feuil2 est à adapter bien sur (toujours pas de fichier exemple sur lequel s'appuyer)
A tu testé mon nouveau code (voir mon postprécédent)?
Cordialement
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re
Après vérifications, il faut remplacer
VB: 
If Not Plg Is Nothing Then Plg.EntireRow.Delete
Par
VB: 
If Not Plg Is Nothing Then
        With Plg.EntireRow
            .Copy Sheets("Feuil2").Range("A1")
            .Delete
        End With
    End If
Feuil2 est à adapter bien sûr
Cordialement
 
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Re : SUPRESSION LIGNE rapidité d'execution

Efgé à dit:
Re
Après vérifications, il faut remplacer
VB: 
If Not Plg Is Nothing Then Plg.EntireRow.Delete
Par
VB: 
If Not Plg Is Nothing Then
        With Plg.EntireRow
            .Copy Sheets("Feuil2").Range("A1")
            .Delete
        End With
    End If
Feuil2 est à adapter bien sûr
Cordialement
Cliquez pour agrandir...

re

merci, je vais prendre de temps de voir tout cela, je n'ai pas testé la deuxiéme solution de supression de ligne,
la premiére est déjà trés rapide, mais j'essaierai la 2éme.
merci pour tout

cordialement
 
Vote positif 0 Vote négatif
T

Tirou

XLDnaute Occasionnel
Re : SUPRESSION LIGNE rapidité d'execution

Bonjour le fil,

Je ne comprends pas bien la ligne set Plg.
Code: 
With Sheets("base de donnée")
    LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plg = .Rows(i + 1)
    For i = LstRw To 1 Step -1
...
En effet, il me semble que la variable i est initialisée juste après dans le for. La macro renvoi t-elle un message d'erreur à ce niveau?

Vu que la première solution a été effacée des archives, je suis fortement preneur des performances de la macro encore postée.
(ou encore que la première macro soit re-postée, je me heurte au même genre de problème d'optimisation)
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re, Bonjour Tirou,
Exact Tirou, une carabistouille suite à des tests....
Le bon code complet:
VB: 
Sub suppressionlignegenerique_2()
Dim i&, Tmp$, Liste$, LstRw&
Dim Plg As Range, Flag As Boolean

Liste = ",TEXTE,PDR,ALARME,BALAI.ASPIRATEUR,COMPOSANT.ELECT.SAV," & _
                "COUVERTURE.AUTO,COUVERTURE.HIVER,COUVERTURE.SOLAIRE," & _
                "ELECTROLYSEUR,FSAVFC,FSAVS1,FSAVS1C,FSAVS1F,FSAVS2," & _
                "FSAVS2C,FSAVS2F,FSAVS3,FSAVS3C,FSAVS4,FSAVS4C," & _
                "FSAVS4C,FSAVS4F,POMPE,POMPE.REGUL,ROBOT,SAV1," & _
                "DIVERS,COUTKM1,PEAGE1,"
                
With Sheets("base de donnée")
    LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plg = .Rows(LstRw + 1)
    For i = LstRw To 1 Step -1
        Tmp = "," & .Cells(i, 1).Value & ","
        Flag = False
        If .Cells(i, 3) Like "COGAR*" Then
            Set Plg = Union(Plg, .Rows(i))
            Flag = True
        End If
        If Flag = False Then
            If InStr(Liste, Tmp) > 0 Then Set Plg = Union(Plg, .Rows(i))
        End If
    Next i
    Application.ScreenUpdating = False
    With Plg.EntireRow
        .Copy Sheets("Feuil2").Range("A1")
        .Delete
    End With
    Application.ScreenUpdating = True
End With
End Sub

Le code précédent que j'avais retiré:
VB: 
Sub suppressionlignegenerique_old()
Dim i&, J&, Tmp$
Dim Plg As Range, LstRw&, Liste(), Flag As Boolean

Liste = Array("TEXTE", "PDR", "ALARME", "BALAI.ASPIRATEUR", "COMPOSANT.ELECT.SAV", _
                "COUVERTURE.AUTO", "COUVERTURE.HIVER", "COUVERTURE.SOLAIRE", _
                "ELECTROLYSEUR", "FSAVFC", "FSAVS1", "FSAVS1C", "FSAVS1F", "FSAVS2", _
                "FSAVS2C", "FSAVS2F", "FSAVS3", "FSAVS3C", "FSAVS4", "FSAVS4C", _
                "FSAVS4C", "FSAVS4F", "POMPE", "POMPE.REGUL", "ROBOT", "SAV1", _
                "DIVERS", "COUTKM1", "PEAGE1")
                
Application.ScreenUpdating = False
With Sheets("base de donnée")
    LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plg = .Rows(LstRw + 1)
    For i = LstRw To 1 Step -1
        Tmp = .Cells(i, 1).Value
        Flag = False
        If .Cells(i, 3) Like "COGAR*" Then
            Set Plg = Union(Plg, .Rows(i))
            Flag = True
        End If
        If Flag = False Then
            For J = LBound(Liste) To UBound(Liste)
                If Liste(J) = Tmp Then
                    Set Plg = Union(Plg, .Rows(i))
                    Exit For
                End If
            Next J
        End If
    Next i
    If Not Plg Is Nothing Then Plg.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re
J'ai oublié les explications:
Cela ne plantai pas car comme i n'était pas valorisé on se retrouvait avec .Rows(0 + 1), donc je supprimais la ligne 1 au lieu de supprimer la ligne vide sous le tableau.
Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2010 supprimer une ligne sur d'autre feuilles en prenant référence sur une feuille journal
Réponses
3
Affichages
401
ccia
C
C
  • Question
Microsoft 365 macro insérer ligne sous-total et changer la couleur et bordure
Réponses
8
Affichages
3 K
Charloooon
C
maval
  • Question
XL 2013 Supprimer ligne
Réponses
6
Affichages
684
maval
maval
R
  • Question
Supression ligne suivant 2 critères contenus dans cellules - amélioration code vitesse
Réponses
12
Affichages
932
rcan7412
R
T
  • Question
XL 2016 Supprimer ligne si cellule vide dans un tableau
Réponses
2
Affichages
666
tyruso
T
F
  • Question
Suppression de ligne avec condition
Réponses
6
Affichages
608
Florian53
F
L
  • Question
Macro supprimer ligne ne fonctionne pas
Réponses
9
Affichages
2 K
Pierrot93
Pierrot93
C
  • Question
Suppression de ligne après un test
Réponses
3
Affichages
689
Choubidoua
C
J
  • Question
effacer ligne
Réponses
2
Affichages
717
julie999
J
C
  • Question
Supprimer ligne en colonne A mais qu'à partir de .....
Réponses
2
Affichages
820
CG2000
C

Membres actuellement en ligne

5 membres et 84 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 099
Membres
103 116
dernier inscrit
kutobi87