Autres Optimisation de macro

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #2

Bonjour

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

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #3

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #4

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 ?

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #5

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

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #6

et le 1 X 2

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #7

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)

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #8

oui

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #9

Conserver toutes les lignes contenant "»"

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #10

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

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #11

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #12

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

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #13

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

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 12 Mars 2022

• #14

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)

 

Vote positif 0 Vote négatif

M

Muratime

XLDnaute Junior

• 12 Mars 2022

• #15

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

 

Vote positif 0 Vote négatif