Autres Optimisation de macro

Muratime · 12 Mars 2022

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

Staple1600 · 12 Mars 2022

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 · 12 Mars 2022

Bonjour

Je ne comprends pas ta logique de suppression des lignes
Quel est le critère retenu pour supprimer les lignes ?

Muratime · 12 Mars 2022

Il supprime les lignes 4 + 6 + 2 etc ce qui corresponde au lignes 4, 10, 12, 13, 15, 16,17, 18, 19, 20 et il fait ça en boucle

Staple1600 · 12 Mars 2022

Re

Oui, mais cela ne n'explique pas pourquoi il doit supprimer ces lignes

Qu'ont-elles de particulières?

Pourquoi il faut les supprimer ?

Muratime · 12 Mars 2022

En faite je veux les garder pour former mes matchs garder l'essentiel , le championnat, le nom des équipes l'heure et les cotes en gras

Muratime · 12 Mars 2022

et le 1 X 2

Staple1600 · 12 Mars 2022

Re

Donc par exemple tu ne veux garder que les deux lignes immédiatement sous une cellule contenant
NS
(cela ferait déjà une piste à creuser)

Muratime · 12 Mars 2022

Muratime · 12 Mars 2022

Conserver toutes les lignes contenant "»"

Staple1600 · 12 Mars 2022

Re

Est-ce qu'on se rapproche du résultat souhaité?

VB:

Sub Traiter_Feuille()
Application.ScreenUpdating = False
supprimer
ranger
Cells(1).CurrentRegion.Columns.AutoFit
End Sub
Private Sub supprimer()
Dim derniereLigne&, i&, j&, vArr
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row
j = 1
For i = derniereLigne To 1 Step -1
If VBA.Trim(Cells(i, 1)) Like "NS" Then
vArr = Cells(i, 1).Offset(1).Resize(15).Value2
Cells(j, "C").Resize(, 15).Value = Application.Transpose(vArr)
End If
j = j + 1
Next
End Sub
Private Sub ranger()
Columns("A:B").Delete
With ActiveSheet.UsedRange
    .Sort .Columns(1), xlAscending, Header:=xlNo 'tri sur 3 colonnes
End With
Rows("1:16").EntireRow.Delete
End Sub

Lancer la macro nommée: Traiter_Feuille

Muratime · 12 Mars 2022

on s'en rapproche mais c'est pas encore ça il me manque toute les lignes contenant "»"

Staple1600 · 12 Mars 2022

Re

Et comme ceci?

VB:

Sub Traiter_Feuille()
Application.ScreenUpdating = False
supprimer
ranger
Cells(1).CurrentRegion.Columns.AutoFit
End Sub
Private Sub supprimer()
Dim derniereLigne&, i&, j&, vArr
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row
j = 1
For i = derniereLigne To 1 Step -1
If VBA.Trim(Cells(i, 1)) Like "NS" Then
vArr = Cells(i, 1).Offset(1).Resize(18).Value2
Cells(j, "C").Resize(, 18).Value = Application.Transpose(vArr)
End If
j = j + 1
Next
End Sub
Private Sub ranger()
Columns("A:B").Delete
With ActiveSheet.UsedRange
    .Sort .Columns(1), xlAscending, Header:=xlNo 'tri sur 3 colonnes
End With
Rows("1:16").EntireRow.Delete
End Sub

Muratime · 12 Mars 2022

c'est un peu mélangé j'aimerais bien conserver l'ordre du fichier ce qui vers le haut l'heure la moins récente et vers les plus tard car la il tri par ordre alphabétique j'ai l’impression

Staple1600 · 12 Mars 2022

Re

Bah, c'est simple il suffit de pas lancer la macro ranger
(mets un ' devant pour ne pas l'appeler dans la macro Traiter_Feuille)

Muratime · 12 Mars 2022

Sais tu pourquoi quand je lance ma macro original la première fois elle fonctionne bien et si je la relance la macro ça rame grave si je referme le fichier idem ça re-fonctionne

Autres Optimisation de macro

Muratime

XLDnaute Junior

Pièces jointes

Staple1600

Staple1600

XLDnaute Barbatruc

Muratime

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Muratime

XLDnaute Junior

Muratime

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Muratime

XLDnaute Junior

Muratime

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Muratime

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Muratime

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Muratime

XLDnaute Junior

Discussions similaires