Autres Optimisation de macro

Muratime

XLDnaute Junior
Bonjour forum, ;)
J'ai deux macros dans mon fichier une qui s'appel "supprimerlignes" et l'autre "rangementfeuille" et je voudrais les optimiser car la première macro met 7 minutes 40 pour faire le job et l'autre 30 secondes ce qui est mieux. Ce qui fait un total de plus de 8 minutes pour ranger 8475 lignes, je pense quelles peuvent faire mieux.
Merci de votre aide
 

Pièces jointes

  • test1.xlsm
    124.3 KB · Affichages: 12
Solution
Re

Alors il faut d'abord ajouter une feuille que tu nommeras RESULTAT
Ensuite tu renommes la feuille où sont tes données en TEST
Puis tu lances la macro Traiter_Feuille
Et ensuite tu vas voir le résultat (je te le donne en mille ;)), sur la feuille RESULTAT
VB:
Sub Traiter_Feuille()
Application.ScreenUpdating = False
supprimer
ranger
End Sub
Private Sub supprimer()
Dim derniereLigne&, i&, vArr, F As Worksheet: Set F = Sheets("TEST")
derniereLigne = F.Range("A" & Rows.Count).End(xlUp).Row
For i = derniereLigne To 1 Step -1
If VBA.Trim(F.Cells(i, 1)) Like "NS" Then
vArr = F.Cells(i, 1).Offset(1).Resize(18).Value2
F.Cells(i, "C").Resize(, 18).Value = Application.Transpose(vArr)
End If
Next
F.Columns("A:B").Delete...

Staple1600

XLDnaute Barbatruc
Re

Alors il faut d'abord ajouter une feuille que tu nommeras RESULTAT
Ensuite tu renommes la feuille où sont tes données en TEST
Puis tu lances la macro Traiter_Feuille
Et ensuite tu vas voir le résultat (je te le donne en mille ;)), sur la feuille RESULTAT
VB:
Sub Traiter_Feuille()
Application.ScreenUpdating = False
supprimer
ranger
End Sub
Private Sub supprimer()
Dim derniereLigne&, i&, vArr, F As Worksheet: Set F = Sheets("TEST")
derniereLigne = F.Range("A" & Rows.Count).End(xlUp).Row
For i = derniereLigne To 1 Step -1
If VBA.Trim(F.Cells(i, 1)) Like "NS" Then
vArr = F.Cells(i, 1).Offset(1).Resize(18).Value2
F.Cells(i, "C").Resize(, 18).Value = Application.Transpose(vArr)
End If
Next
F.Columns("A:B").Delete
F.Rows("1:3").EntireRow.Delete
End Sub
Private Sub ranger()
Sheets("RESULTAT").Range("T2").FormulaR1C1 = "='TEST'!RC[-19]<>"""""
Sheets("TEST").Columns("A:R").AdvancedFilter _
                Action:=xlFilterCopy, CriteriaRange:=Sheets("RESULTAT").Range("T1:T2"), _
                CopyToRange:=Sheets("RESULTAT").Range("A1")
End Sub
PS: j'ai testé le code avant de le publier ici.
Doc test OK et code fonctionnel.
 

Muratime

XLDnaute Junior
Cela est pas mal ta macro à l'avantage de ne pas ramer, me reste plus qu'a déplacer des colonnes, formater en heure ou simplement sur la feuille 3 mettre des formules pour transposer ce que je garde et faire un truc plus lisible pour moi
 

Staple1600

XLDnaute Barbatruc
Re

Muratime
Donc le code du message#16 fonctionne ?
Pourquoi tu parles de feuille 3 ?
Mon code n'utilise que deux feuilles: TEST et RESULTAT

[aparté]
car la première macro met 7 minutes 40 pour faire le job et l'autre 30 secondes ce qui est mieux. Ce qui fait un total de plus de 8 minutes pour ranger 8475 lignes,
Personnellement, je n'appelle pas cela "pas mal" :rolleyes:
Vu que ma macro s'exécute en moins de 5 secondes sur mon PC
 

Muratime

XLDnaute Junior
Oui la macro message 16 fonctionne, après quand le dis pas mal c'est top :p mis je ne comprend pas pourquoi ma macro se met a ramer dès que j'enregistre le fichier en quittant ou alors faut quitter sans enregistrer mais je ne peux pas la lancer deux fois de suite :mad: en tous cas merci beaucoup ;) je vais mettre en résolu le reste je vais essayer de me débrouiller
 

Staple1600

XLDnaute Barbatruc
Re

Non
ci-dessous deux petites macros pour mieux comprendre
(faire ce test sur une feuille vierge)
VB:
Sub test_A()
[A1:A10] = "test"
Dim derlig&, i&
derlig = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To derlig
MsgBox Cells(i, 1).Address
Next
For i = derlig To 1 Step -1
MsgBox Cells(i, 1).Address
Next
End Sub
Sub test_B()
Dim derlig&, i&
derlig = Range("A" & Rows.Count).End(xlUp).Row
For i = derlig To 1 Step -1
MsgBox Cells(i, 1).Address
Next
End Sub
 

Muratime

XLDnaute Junior
La macro A fait deux fois de 1 a 10 puis de 10 a 1
La macro B est mieux car elle part de la fin de 10 a 1
M'en doutais qu'il y avait une couille dans ma macro quand j'ai omis de mettre le Application.ScreenUpdating = False j'ai vu le truc qui partais du début pour allez ver la fin et la me suis dis s'il va jusque la ligne 1048576 ça va ramer :D
 

Staple1600

XLDnaute Barbatruc
Re

Excuse - mauvais copié/collé
La 1ère macro aurait du être
VB:
Sub test_A()
[A1:A10] = "test"
Dim derlig&, i&
derlig = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To derlig
MsgBox Cells(i, 1).Address
Next
End Sub
Donc tu vois que ce n'est pas la même boucle.
 

Muratime

XLDnaute Junior
Bonjour Staple1600, il y a un petit problème je me retrouve avec une colonne décalé, sur le coup j'ai pas vu c'est quand j'ai mis mes mfc que j'ai vu.
Sans titre.png
 

Pièces jointes

  • Classeur1.xlsm
    33.4 KB · Affichages: 1

Discussions similaires

Réponses
18
Affichages
803

Statistiques des forums

Discussions
311 720
Messages
2 081 923
Membres
101 840
dernier inscrit
SamynoT