SUPRESSION LIGNE rapidité d'execution

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
 

Tirou

XLDnaute Occasionnel
Re : SUPRESSION LIGNE rapidité d'execution

Merci Efgé de tes explications (et des macros complètes)

J'aurais pensé que l'appel à la variable indéfinie renvoi une erreur ou que i prenne une valeur aléatoire.

Cordialement
 

Tirou

XLDnaute Occasionnel
Re : SUPRESSION LIGNE rapidité d'execution

J'en profite pour poser une question tout bête :

Pour améliorer les performances, tu es passé par la mise en place d'un équivalent de dictionnaire et au regroupement des suppressions de ligne.

Ma question concerne le gain lié à chacune de ces 2 sous solutions? si l'on devait choisir (et c'est en ça que ma question est bête, il "suffit" de faire les 2) lequel serait à privilégier?
 

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re
Il n'y as pas de question bête :)
Dans le code suppressionlignegenerique_old j'utilise un tableau (pas un dictionnaire).
Ensuite je boucle sur toutes les valeurs du tableau (For J = LBound(Liste) To UBound(Liste))
Si je rencontre la même valeur que la cellule i, je groupe la ligne.

Pour éviter cette boucle For j =..., dans le code suppressionlignegenerique_2, je dis que liste est une chaisne de caractères, un simple texte.
Ensuite je vérifie que le texte de la cellule i (avec une virgule devant et une virgule derière Tmp = "," & .Cells(i, 1).Value & ","
) se trouve dans mon texte Liste. Pas de boucle grâce & If InStr(Liste, Tmp) > 0

Si on regarde par rapport au code donné en post 1, le gain se fait sur les deux actions : Récupération des numéros de lignes ET sur le fait que l'on supprime toutes les lignes en un seul coup.
Le plus long dans un code VBA est de "toucher" à la feuille.
En groupant on y touche une seule fois, si non, une fois par ligne supprimée (comme ici on parle de plus de 200 000 lignes...)

Si il y avait choix à dfaire, je pense qu'il faudrait garder le regroupement, mais vu le premier code, le gain ne serait certainement plus aussi important, même si il me semble certain que l'on serait loin, très loin, des 7 à 8 minutes évoquées pour 4 500 lignes

Cordialement
 

PASCAL84810

XLDnaute Junior
Re : SUPRESSION LIGNE rapidité d'execution

re,

c'est encore moi, désolé je n'arrive pas à adapter sur la colonne 12, cela devrait etre comme ci dessous, non :
ps : pour ne pas tenir compte de "like cogar" où est-ce que je coupe ?
et sans vouloir abuser est-ce que je peux utiliser aussi "Selection.PasteSpecial" à la place de "delete" dans
With Plg.EntireRow
.Copy Sheets("FEUIL3").Range("A1")
.Delete
pour ne pas couper mais juste copier (j'ai besoin des deux en faite, suivant les colonnes où je selectionne les cellules texte)

merci

clt
Sub COUPERCOLLER()


Dim i&, Tmp$, Liste$, LstRw&
Dim Plg As Range, Flag As Boolean

Liste = ",Changement,Réception,"

Application.ScreenUpdating = False
With Sheets("BASE")
LstRw = .Cells(.Rows.Count, 12).End(xlUp).Row
Set Plg = .Rows(i + 1)
For i = LstRw To 1 Step -1
Tmp = "," & .Cells(i, 12).Value & ","
Flag = False
If .Cells(i, 1) 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
With Plg.EntireRow
.Copy Sheets("FEUIL3").Range("A1")
.Delete
End With
End If
End With
Application.ScreenUpdating = True
End Sub
 

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Re
On commence à s'éloigner du sujet initial.... :rolleyes:

@ PASCAL84810
Pourrais-tu utiliser les balises Code quand tu mets du code dans ton post ?
Quand tu réponds tu va en mode avancé puis tu clique sur la balise Code (#), cela va te donner :
[CODE ]Ton code doit être ici [ /CODE ]
par avance merci, c'est quand même plus simple à lire.

Pour tes demandes
je n'arrive pas à adapter sur la colonne 12,
Sans exemple, je ne vois pas ce qui cloche.
pour ne pas tenir compte de "like cogar" où est-ce que je coupe
Tu aurais pu avoir une piste :
VB:
If .Cells(i, 1) Like "cogar" Then
    Set Plg = Union(Plg, .Rows(i))
    Flag = True
End If
est-ce que je peux utiliser aussi "Selection.PasteSpecial" à la place de "delete" dans
With Plg.EntireRow
.Copy Sheets("FEUIL3").Range("A1")
.Delete
pour ne pas couper mais juste copier (j'ai besoin des deux en faite, suivant les colonnes où je selectionne les cellules texte)
Tu donnes la réponse dans ta question :si tu ne veux pas de Delete, tu aurais pu essayer de l'enlever, pour "voir ce qui passe"

Pour le PasteSpecial, et si on veux faire propre, il faudrait tout changer (Remplir un tableau et le coller) mais pour ça il faut le nombre de colonne, leur emplacemeent, enfin bref un exemple (mais je crois en avoir déjà parlé) et on risque de rallonger le traitement....

Voici ce que je te propose:


VB:
Sub suppressionlignegenerique_3()
Dim i&, Liste$, LstRw&
Dim Plg As Range


Liste = ",Changement,Réception,"


With Sheets("base de donnée")
    LstRw = .Cells(.Rows.Count, 12).End(xlUp).Row
    Set Plg = .Rows(LstRw + 1)
    For i = LstRw To 1 Step -1
        If InStr(Liste, "," & .Cells(i, 12).Value & ",") > 0 Then _
        Set Plg = Union(Plg, .Rows(i))
    Next i
    Plg.EntireRow.Copy Sheets("Feuil2").Range("A1")
End With
End Sub
Cordialement
 

Tirou

XLDnaute Occasionnel
Re : SUPRESSION LIGNE rapidité d'execution

Le plus long dans un code VBA est de "toucher" à la feuille.

Je te remercie de cette précision. Je commence à mieux comprendre pourquoi la plupart de mes macro ramment (pas tant que ça, mais vu la puissance de nos ordi, je trouve que les quelques secondes pour des opérations simples sont déjà trop)

J'essayerai d'inclure cela (et les autres conseils souvent répétés) à mes futures macros. Encore merci
 

Tirou

XLDnaute Occasionnel
Re : SUPRESSION LIGNE rapidité d'execution

Rebonjour,

Je sais que je m'éloigne du fil du sujet, mais juste pour comparaison, je me suis amusé à tester les 2 solutions.

VB:
Sub temp()
Const nbIteration = 10000000

Liste1 = ",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,"

Liste2 = 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")
Dim i As Long
Dim J As Long
debut = LBound(Liste2)
fin = UBound(Liste2)
Const tmp = "test"

time0 = Time
For i = 1 To nbIteration
    If InStr(Liste1, tmp) > 0 Then
        End If
    Next i

time1 = Time

For i = 1 To nbIteration
    For J = debut To fin
        If Liste2(J) = tmp Then
            Exit For
            End If
        Next J
    Next i
    
time2 = Time
For i = 1 To nbIteration
    If tmp = "TEXTE" Then
        End If
    If tmp = "PDR" Then
        End If
    If tmp = "ALARME" Then
        End If
    If tmp = "BALAI.ASPIRATEUR" Then
        End If
    If tmp = "COMPOSANT.ELECT.SAV" Then
        End If
    If tmp = "COUVERTURE.AUTO" Then
        End If
    If tmp = "COUVERTURE.HIVER" Then
        End If
    If tmp = "COUVERTURE.SOLAIRE" Then
        End If
    If tmp = "ELECTROLYSEUR" Then
        End If
    If tmp = "FSAVFC" Then
        End If
    If tmp = "FSAVS1" Then
        End If
    If tmp = "FSAVS1C" Then
        End If
    If tmp = "FSAVS1F" Then
        End If
    If tmp = "FSAVS2" Then
        End If
    If tmp = "FSAVS2C" Then
        End If
    If tmp = "FSAVS2F" Then
        End If
    If tmp = "FSAVS3" Then
        End If
    If tmp = "FSAVS3C" Then
        End If
    If tmp = "FSAVS4" Then
        End If
    If tmp = "FSAVS4C" Then
        End If
    If tmp = "FSAVS4C" Then
        End If
    If tmp = "FSAVS4F" Then
        End If
    If tmp = "POMPE" Then
        End If
    If tmp = "POMPE.REGUL" Then
        End If
    If tmp = "ROBOT" Then
        End If
    If tmp = "SAV1" Then
        End If
    If tmp = "DIVERS" Then
        End If
    If tmp = "COUTKM1" Then
        End If
    If tmp = "PEAGE1" Then
        End If
    Next i
    
time3 = Time

Cells(1, 1).Value = time1 - time0: Cells(1, 2).Value = "Temps procédure par instr"
Cells(2, 1).Value = time2 - time1: Cells(2, 2).Value = "Temps procédure par Array"
Cells(3, 1).Value = time3 - time2: Cells(3, 2).Value = "Temps procédure par if multiples"
End Sub

Le résultat est probant : après reconversion d'unité on arrive à 3 secondes pour la version avec Instr contre 50 secondes pour la version avec tableau.
Par contre, la méthode avec la succession de if ne met que 13 secondes !!!! elle est plus efficace que la version avec le tableau ! (à la condition que l'accès dans la feuille excel et le resultat enregistré dans une variable plutôt qu'un accès systématique à chaque test)


Par contre Efgé (et oui, j'ai plein de questions !!! ) quand j'ai essayé de déclarer le tableau par
const Liste2$ = array(blabla)
j'ai reçu 2 message d'erreur. le premier était que array n'était pas une constante (comprend pas, mais bon suis discipliné, j'ai retiré le const) et le second que le type de donnée de Liste2$ n'était pas une liste par la suite.
Peux tu m'expliquer ? :)

MAJ avec la comparaison des multiples IF
 
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : SUPRESSION LIGNE rapidité d'execution

Bonjour Tirou, le fil
Un tableau VBA (Array) n'est jamais une constante.
Si tu déclare Dim Liste2$ tu déclare Dim Liste2 As String. Donc VBA attend un texte
Si tu veux déclarer un tableau qui ne comportera QUE des textes (strings) tu peux utiliser Dim Liste2() As String.
Dans ce cas tu devras remplir le tableau avec des lignes de type :
Redim Preserve Liste2(1 to 1)
Liste2(1) = "Toto"
Redim Preserve Liste2(1 to 2)
Liste2(2) = "Tutu"
etc...
Quand tu utilise Dim Liste2 As Variant, tu peux déclarer ton tableau plus directement : Liste2 = Array("Toto", "Tutu")
LE type de Liste2 ne sera jamais "liste", ce type n'existe, à ma connaissance, pas. Tu retrouveras Array pour Liste2 et String pour Liste1.
Cordialement
 

Tirou

XLDnaute Occasionnel
Re : SUPRESSION LIGNE rapidité d'execution

J'avais lu quelque part que déclarer les constantes en tant que telles permet d'alléger le temps d’exécution car les constantes ne sont pas réévaluées à chaque fois.

De ce que tu dis, j'en conclue qu'on ne peut pas déclarer un tableau de constantes... dommage

Encore merci :)
 

Discussions similaires

Réponses
6
Affichages
691

Statistiques des forums

Discussions
312 330
Messages
2 087 339
Membres
103 524
dernier inscrit
Smile1813