Macro trop longue à s'exécuter

  • Initiateur de la discussion Initiateur de la discussion Boby71C
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Boby71C

XLDnaute Impliqué
Bonjour à tous
J'ai élaboré une macro pour supprimer des données sur un fichier faisant plus de 10 000 lignes pour conserver seulement celles dont j'ai besoin pour la suite.
Ma macro fonctionne bien mais je supprime ligne à ligne et c'est très long à s'exécuter.
Je joints mon fichier très réduit pour avoir vos conseils pour un déroulement plus rapide.

Merci à vous et excellent Dimanche et très bonne fête à toutes les Maman

@+ [file name=EBT2.zip size=50573]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/EBT2.zip[/file]
 

Pièces jointes

Bonjour Boby71C,

Je suis pas un très grand pro de VisualBasic mais en regardant le code il y a quand même quelque chose qui m'a surpris, c'est que tu mets au début :

Application.ScreenUpdating = True

Et vers la fin de ta macro :

Application.ScreenUpdating = False

A mon avis en faisant l'inverse (d'abord False et à la fin en True), tu devrais gagner beaucoup en rapidité. A moins qu'il y ait une raison particulière à ton ordre (raison qui m'échappe).

Bonne journée,
Ciao ciao !! 😉
 
Bonjour Law et le forum.
Tu as raison, il s'agit d'une grossière erreur que je vais corriger de suite.
Je reste persuadé que ma méthode n'est pas la plus simple et qu'il doit exister un moyen plus rapide pour la faire tourner avec un système de compteur. Mais pour cela, je ne suis pas assez calé.

Merci pour ta remarque très judicieuse.
Bon Dimanche.
@+
 
bonjour Bobby, Law,

j'ai simplifié un peu la macro qui, du coup est plus nerveuse :

'************************************************
Sub Sup_Act()
Dim LastLine As Long
Workbooks('EBT2.3.xls').Activate
Application.ScreenUpdating = False


'Tri des activités
Cells.Select
Selection.Sort Key1:=Range('B2'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LastLine = Range('A65536').End(xlUp).Row

For i = LastLine To 2 Step -1
Select Case Cells(i, 2)
Case 1 To 19, 21 To 44, 46 To 114, 116 To 404, 406 To 499
Cells(i, 1).EntireRow.Delete shift:=xlUp
End Select
Next

End Sub

EDITION
bonjour Thierry,
presque la même 😉

Message édité par: AeroPlanneur, à: 28/05/2006 12:22
 
Salut

Utilise cette macro :

Code:
Sub Sup_Act()
Dim Plage As Range, Lgn&

  Application.ScreenUpdating = False
  With ThisWorkbook.Worksheets('EBT2.3')
    Set Plage = .Range('A1', .Range('D1').End(xlDown))
  End With

  'Tri des activités
  With Plage
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=True, MatchCase:=False
    'supprimer les activités différentes de 20,45,115,405 et 500
    For Lgn = .Rows.Count To 2 Step -1
      Select Case .Cells(Lgn, 2)
        Case 20, 45, 115, 405, 500
        Case Else
          Range(.Cells(Lgn, 1), .Cells(Lgn, 20)).Delete xlUp
      End Select
    Next Lgn
  End With
  Application.ScreenUpdating = True
End Sub
 
Pas pratique ce code qui se met mal en forme, j'essaie tel quel :

Sub Sup_Act()
Dim Plage As Range, Lgn&

Application.ScreenUpdating = False
With ThisWorkbook.Worksheets('EBT2.3')
Set Plage = .Range('A1', .Range('D1').End(xlDown))
End With

'Tri des activités
With Plage
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=True, MatchCase:=False
'supprimer les activités différentes de 20,45,115,405 et 500
For Lgn = .Rows.Count To 2 Step -1
Select Case .Cells(Lgn, 2)
Case 20, 45, 115, 405, 500
Case Else
Range(.Cells(Lgn, 1), .Cells(Lgn, 20)).Delete xlUp
End Select
Next Lgn
End With
Application.ScreenUpdating = True
End Sub
 
Re Bobby,

Le fichier a été amputé de quelques lignes pour pouvoir passer à 50 Ko.

Cordialement

Bernard [file name=SuppActivitesV1.zip size=21903]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/SuppActivitesV1.zip[/file]
 
Bonjour les amis.
J'ai testé le fichier de Bernard mais aparement, il fait le contraire de mon besoin. Il supprime les 20, 45, 115, 405 et 500 alors que c'est ceux dont j'ai besoin.
😱 Je n'ai pas réussis à comprendre le code pour en effectuer la modification.
Pour le code de jmps, ça tourne très longtemps et pas de résultat.
Avec les codes que vous m'avez apportés précèdement, ça tourne donc je pense que je vais m'en satisfaire.

Je vous remercie tous du fond du coeur de m'avoir apporté votre aide. J'espère un jour être à votre hauteur en VBA.
Merci à tous

@+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour