Autres Optimisation de macro

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #16

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.

 

Vote positif 0 Vote négatif

Solution

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #17

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #18

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,

Cliquez pour agrandir...

Personnellement, je n'appelle pas cela "pas mal"
Vu que ma macro s'exécute en moins de 5 secondes sur mon PC

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #19

Oui la macro message 16 fonctionne, après quand le dis pas mal c'est top 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 en tous cas merci beaucoup je vais mettre en résolu le reste je vais essayer de me débrouiller

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #20

Re

Regardes ma boucle
Moi je pars de la fin (toi non)

=>ta boucle
For l = 1 To derniereLigne

=>ma boucle
For i = derniereLigne To 1 Step -1

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #21

VB:

derniereLigne = Range("A" & Rows.Count).End(xlUp).Row

et ceci ça part pas de la fin ?

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #22

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

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #23

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #24

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.

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #25

Comme dirais Arnaud merci pour le petite explite site

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #26

oui de toute façon il va traiter les 1048576 ligne si tu pars du début

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #27

Re

Non, le souci est que quand on veut supprimer des lignes il faut toujours partir de la fin
(d'où ce type de boucle)
For i = derlig To 1 Step -1

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 13 Mars 2022

• #28

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.

 

Pièces jointes

• Classeur1.xlsm

  33.4 KB · Affichages: 1

Vote positif 0 Vote négatif