Code suppression de plage avec condition un peu lent à l’exécution

[Daroumx]

Bonjour le forum,

J'ai une macro avec laquelle je supprime une plage avec condition dans un fichier qui fait en moyenne 160000 lignes j'utilise pour l'instant ce code là mais il met environ 32 sec pour supprimer les plage:

Sub Suppr()

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual

Dim l, derl As Long
derl = Range("A" & Rows.Count).End(xlUp).Row

For l = derl To 1 Step -1
    If Cells(l, 1) Like ("*---*") Then
    Range("A" & l - 11 & ":A" & l + 1).EntireRow.Delete
    End If
Next l

    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

J'ai donc pensé à utiliser la méthode find mais ça ne supprime pas toutes les lignes et ça prend environ 58 sec et je dois avouer que je ne suis pas habitué à utiliser cette méthode voici le code :

Sub Suppr_find()

With Application
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
 
 Dim l, derl As Long
 Dim cell, plg As Range
 Dim x As Variant

 derl = Range("A" & Rows.Count).End(xlUp).Row
 Set plg = Range("A1:A" & derl)
 
 For Each cell In plg
     Set x = cell.Find("---", , , xlPart, , xlPrevious, , False)
     If Not x Is Nothing Then Range(cell.Offset(-11, 0), cell.Offset(1, 0)).EntireRow.Delete
 Next cell
 
 
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
 End With
 

End Sub

Donc je me demandais s'il existait une autre méthode plus rapide pour supprimer une plage avec condition en vous remerciant d'avance pour votre aide .

 

[Robert]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour Daroumx, bonjour le forum,

Essaie avec un filtre automatique ça devrait aller bien plus vite. Pas testé vu que tu n'as pas daigné mettre un fichier exemple...
Le code :

Sub Suppr()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Application.Calculation = xlCalculationManual
Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A1:A" & DL) 'définit la palge PL
O.Range("A1").AutoFilter Field:=1, Criteria1:="*---*" 'filtre la colonne A avec tous ce qui contient "---" comme critère
Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV des cellules vsisibles de la plage PL
PLV.EntireRow.Delete 'supprime les lignes entière de la plage PLV
O.Range("A1").AutoFilter 'supprime le filtre automatique
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Daroumx]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour Robert , le forum.

Je vous remercie pour votre réponse et je m'excuse de ne pas avoir joint un fichier exemple.Mais mon problème ici est la lenteur d'exécution de ma macro qui doit traiter un fichier avec 160.000 lignes environ. J'ai essayé avec la méthode find mais ça prenait un peu plus de temps comme je l'ai mentionné dans mon message précédent.

Concernant votre code il filtre et supprime uniquement la ligne visible contenant les "---" et non pas une plage.
Je vous joint un fichier exemple avec la macro que j'utilise actuellement et la macro avec la méthode find que j'ai essayer d'utiliser.

Je cherche à rendre la macro un peu plus rapide pour un fichier de 160.000 lignes donc je me demandais si il existait des méthodes différentes ou une meilleure adaptation de la méthode find en vous remerciant pour votre aide précieuse.

 

[Gelinotte]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour,

Ta macro n'est pas si mal. Excepté qu'au moment où les 12 lignes sont effacées, ton pointer de ligne "L", lui reste 12 lignes plus bas.

Le traitement vérifie donc 11 lignes pour rien.

L=L-11 après l'effacement accélérerait sûrement le traitement.

Teste, au besoin envoie-nous seulement la colonne A qui a 160 000 lignes pour tester réel


Geli

 

[Robert]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour le fil, bonjour le forum,

Désolé Daroumx mais chez moi ça fait ce que tu demandes dans ta requête. J'ai repris ton fichier en faisant des copier/coller pour obtenir plus de 12 milles lignes. Le code s'exécute en 0,1484375 secondes sur ma machine.
Essaie chez toi...
Le code adapté :

Sub Suppr()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)

deb = Timer
Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Application.Calculation = xlCalculationManual
Set O = Sheets("Exemple") 'définit l'onglet O (à adapter à ton cas)
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A1:A" & DL) 'définit la palge PL
O.Range("A1").AutoFilter Field:=1, Criteria1:="*---*" 'filtre la colonne A avec tous ce qui contient "---" comme critère
Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV des cellules vsisibles de la plage PL
PLV.EntireRow.Delete 'supprime les lignes entière de la plage PLV
O.Range("A1").AutoFilter 'supprime le filtre automatique
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
fin = Timer - deb
MsgBox Timer
End Sub

Le fichier augmenté :

 

[Efgé]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour à tous
Robert , je pense que la méprise viens de :
Range(cell.Offset(-11, 0), cell.Offset(1, 0)).EntireRow.Delete
Par filtre tu récupères les "----" mais pas de la ligne -11 à la ligne + 1

Il faudrait, peut être quelque chose comme ça:

Sub test()
Dim plg As Range, T As Variant, i&
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
With Sheets("Exemple")
    T = .Range(.Cells(1, 1), Cells(.Rows.Count, 1).End(3))
    Set plg = .Rows(UBound(T, 1) + 1)
    For i = 1 To UBound(T, 1)
        If T(i, 1) Like ("*---*") Then Set plg = Application.Union(plg, Rows(i - 11 & ":" & i + 1))
    Next i
    plg.Select
End With
    
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Mais j'ai peur que sur 160 000 lignes la charge maximale de Union soit atteinte.
De plus, le -11 n'as pas l'air constant sur l'exemple donné (parfois des lignes marquées "Données" sont incluse dans la plage).
Enfin , bref, c'est juste comme ça
Cordialement

 

[Robert]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour le fil, bonjour le forum,

Efgé a tout à fait raison. Il y a méprise de ma part et, par conséquent, des excuses du sot par seaux, que dis-je, par bassines voire même par cuves viennent inonder et noyer ma honte...

 

[Si...]

Re : Code suppression de plage avec condition un peu lent à l’exécution

salut

Si... le tri ne gêne pas, une solution plus rapide

Sub Macro3()
  Dim debut, L As Long
  debut = Timer
  With Application
   .ScreenUpdating = 0
   .Calculation = xlCalculationManual
    [A:A].Sort [A1], 2
    L = [A:A].Find("--").Row
    Rows(L & ":" & 200000).Delete
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = -1
  End With
  MsgBox Timer - debut
End Sub

si oui, avec le filtre :

Sub Macro2()
  Dim debut
  debut = Timer
  With Application
   .ScreenUpdating = 0
   .Calculation = xlCalculationManual
    Range("A:A").AutoFilter Field:=1, Criteria1:="-*"
    Rows("1:178561").SpecialCells(xlCellTypeVisible).Delete
    [A1].AutoFilter
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = -1
  End With
  MsgBox Timer - debut
End Sub

 

[Daroumx]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour à tous ,


Je vous remercie tous pour votre aide.J'ai appliqué votre indication Geli et j'ai pu gagner 2 secondes avec le l = l -11.
Pour Si... votre code supprime seulement les lignes contenant les --- et non pas la plage : Range(cell.offset(-11,0) , Cell.offset(+1,0)) comme mentionné dans le 1er message.

J'ai aussi appliqué votre code Efgé sur les 160.000 lignes mais ça prend un peu plus de temps que celui que j'applique actuellement et effectivement j'ai mal renseigné le fichier exemple je m'en excuse ^^'.

J'ai essayer avec une autre variable tableau mais apparemment j'ai du mal codé puisque ça me renvoie une erreur 9 l'indice n'appartient pas à la sélection voici le code :

Sub suppr()

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Dim plg
Dim derl, l As Long
Dim duree As Date
debut = Time
derl = Range("A" & Rows.Count).End(xlUp).Row
plg = Range("A1:A" & derl)

For l = UBound(plg) To LBound(plg) Step -1
If plg(l) Like ("*---*") Then
plg(l) = Empty
plg(l + 1) = Empty
plg(l - 1) = Empty
plg(l - 2) = Empty
plg(l - 3) = Empty
plg(l - 4) = Empty
plg(l - 5) = Empty
plg(l - 6) = Empty
plg(l - 7) = Empty
plg(l - 8) = Empty
plg(l - 9) = Empty
plg(l - 10) = Empty
plg(l - 11) = Empty
l = l - 11

End If
Next

Range("A1:A" & derl).Clear
Range("A1:A" & derl) = plg

    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationAutomatic
    End With

Fin = Time
duree = Fin - debut
MsgBox duree

End Sub

Peut être qu'il n'existe pas de manière plus rapide ... en tout cas merci pour votre aide

 

[Daroumx]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Re à tous,

Finalement je me suis rendu compte que j'avais oublié d'indiquer la dimension

Donc j'ai opté pour ce code le traitement s'effectue en 2 seconde et me renvoie le résultat sauf que les lignes supprimées reste vide bon reste plus qu'a filtrer je suppose voici le code :

Sub suppr()

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Dim plg
Dim derl, l As Long
Dim duree As Date
debut = Time
derl = Range("A" & Rows.Count).End(xlUp).Row
plg = Range("A1:A" & derl)

For l = UBound(plg) To LBound(plg) Step -1
If plg(l, 1) Like ("*Référence*") Then
plg(l, 1) = Empty
plg(l + 1, 1) = Empty
plg(l - 1, 1) = Empty
plg(l - 2, 1) = Empty
plg(l - 3, 1) = Empty
plg(l - 4, 1) = Empty
plg(l - 5, 1) = Empty
plg(l - 6, 1) = Empty
plg(l - 7, 1) = Empty
plg(l - 8, 1) = Empty
plg(l - 9, 1) = Empty
plg(l - 10, 1) = Empty
plg(l - 11, 1) = Empty
l = l - 11

End If
Next

Range("A1:A" & derl).Clear
Range("A1:A" & derl) = plg

    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationAutomatic
    End With

Fin = Time
duree = Fin - debut
MsgBox duree

End Sub

Merci pour votre aide à tous.

 

[Robert]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Bonjour le fil, bonjour le forum,

La fonction Find ne nécessite pas de boucle peut-être ce code te permettra d'aller un pleu plus vite...

Sub Suppr_find()
Dim DL As Long
Dim PL As Range
Dim R As Range
Dim PA As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

DL = Cells(Application.Rows.Count, 1).End(xlUp).Row
Set PL = Range("A1:A" & DL)
Set R = PL.Find("---", , xlValues, xlPart)
If Not R Is Nothing Then
    PA = R.Address
    Do
        Range(R, R.Offset(-11, 0)).EntireRow.Delete
        Set R = PL.FindNext(R)
    Loop While Not R Is Nothing And R.Address <> PA
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Daroumx]

Re : Code suppression de plage avec condition un peu lent à l’exécution

Re Robert , Le forum ,

Merci pour votre proposition Robert. Quand je lance la macro ça me supprime la 1 ère plage qui doit être supprimée Mais par la suite ça m'affiche une erreur 1004 : Impossible de lire la propriété FindNext de la classe Range et me souligne en débogage la ligne de code suivante :Set R = PL.FindNext(R)