Optimisation code pour traiter 25000 lignes *12 onglets
Bonsoir le forum je viens de lancer ma macro qui fonctionnanit bien sur un petit test de quelques lignes mais là le temps ne s’arrête pas de tournée et ma macro n'avance pas.
Pour idée je vérifie actuellement pour chaque ligne 2 conditions
Tout d 'abord si la valeur de la colonne 4 est >= a la colonne 5 je supprime la ligne
sinon je vérifie si la la valeur de la colonne 5 >= a la 6 si oui je supprime..
Soit
For Each LaFeuille In WBA.Worksheets
LaFeuille.Columns("I:I").Delete Shift:=xlToLeft
For i = 3 To Range("B1048576").End(xlUp).Row
If LaFeuille.Cells(i, 2) <> "" Then
If LaFeuille.Cells(i, 4).Value >= LaFeuille.Cells(i, 5).Value Then
LaFeuille.Rows(i).Delete
i = i - 1
Else
If LaFeuille.Cells(i, 5).Value >= LaFeuille.Cells(i, 6).Value Then
LaFeuille.Rows(i).Delete
i = i - 1
End If
End If
End If
Next i
puis dans un second temps je rajoute une formule en colonne 9 pour toutes les lignes restantes ( non supprimées)
LaFeuille.Cells(2, 9).FormulaR1C1 = "Delta"
LaFeuille.Cells(3, 9).FormulaR1C1 = "=RC[-3]-RC[-4]"
LaFeuille.Cells(3, 9).AutoFill Destination:=LaFeuille.Range("I3:I" & Range("B1048576").End(xlUp).Row), Type:=xlFillDefault
Next
c'est du codage barbare mais qui fonctionnait bien sur mes 15 lignes de test,
mais là ça mouline...
si vous avez quelques astuces pour optimiser ceci
Bonjour,
579 message et tu n'as pas encore compris qu'on ne traitait pas avec VBA comme avec un vulgaire saucisson !
2 rondelles et même pas de fichier... Visiblement ta pas pris de bonnes résolution pour 2019...
Pour ce que je vois, je suis même étonné que ton truc y couine pas et qu'il ne te fasse pas une erreur 400 définitive !
Dans cette expression :
For i = 3 To Range("B1048576").End(xlUp).Row
s'applique à je ne sais quelle feuille de n'importe quel classeur.
...mais probablement pas à LaFeuille !
donc si la feuilleactive au moment d'entrer dans la boucle fait 25000 ligne la macro traite toujours 25000 ligne quelle que soit LaFeuille. (Ceci dans l'hypothèse la moins catastrophique)
Je te cause même pas de toutes les autres hypothèses peu avouable auxquelles je pense....
Dans cette expression :
LaFeuille.Cells(3, 9).AutoFill Destination:=LaFeuille.Range("I3:I" & Range("B1048576").End(xlUp).Row)
...Je suis vraiment étonné que le compilateur accepte ça : C'est au minimum
LaFeuille.Range("I3:I" & LaFeuille.Range("B1048576")
Pour le reste je peux pas t'en dire plus... J'suis comme ta macro : je mouline ! Je suppute...
Bon je te parle pas de déclaration de variables ni de tout le reste hein... tu t'en fout ?
Epi d'abord comment tu sais que tu sais que ton truc y mouline sur tes 2 rondelles et pas sur l'os qu'il trouve entre les 2 ?
Tu as testé Ctrl+Pause toutes les 2 secondes pour voir la valeur de i et la ligne en cours ? Si ça se trouve y mouline complètement ailleurs... dans une partie non visible de ton code...
Tu pourrais aussi essayer ça dans la fenêtre d'exécution à chaque fois :
?LaFeuille.Name
?Range("B1048576").End(xlUp).Row
C'est comme ça qu'on fait du débogage pas sur 15 lignes de test !
Pfff... Encore une journée de fichue !
A+
Bonjour,
A tester.
Quand on supprime des lignes, il est fortement conseillé de commencer par le bas de la feuille et comme le dit galopin01
Sub Test()
Dim WBA As Workbook
Dim LaFeuille As Worksheet
Dim I As Long
'je suppose ?
Set WBA = ThisWorkbook
For Each LaFeuille In WBA.Worksheets
With LaFeuille
.Columns("I:I").Delete Shift:=xlToLeft
For I = .Cells(.Rows.Count, 2).End(xlUp).Row To 3 Step -1
If .Cells(I, 2) <> "" Then
If .Cells(I, 4).Value >= .Cells(I, 5).Value Then .Rows(I).Delete Else If .Cells(I, 5).Value >= .Cells(I, 6).Value Then .Rows(I).Delete
End If
Next I
.Cells(2, 9).Value = "Delta"
.Cells(3, 9).FormulaR1C1 = "=RC[-3]-RC[-4]"
.Cells(3, 9).AutoFill .Range("I3:I" & .Cells(.Rows.Count, 2).End(xlUp).Row), xlFillDefault
End With
Next LaFeuille
End Sub
Bonjour à vous 2,
Effectivement, galopin je me suis aperçut de l'erreur vers 3 heures du matin que mon
LaFeuille.Range("I3:I" & Range("B1048576").End(xlUp).Row)
était franchement foireux, et je suis arrivé a la meme solution que Theze
, C'est pas bête j'y avais jamais pensé, je suis encore vraiment une buse quand je m' y met.il est fortement conseillé de commencer par le bas de la feuille
Du coup y a pas mieux que 2 boucles pour faire le test, ??
je garde ta solution Theze beaucoup lisible que la mienne finalement
For Each LaFeuille In WBA.Worksheets
LaFeuille.Columns("I:I").Delete Shift:=xlToLeft
For i = 3 To LaFeuille.Cells(Rows.Count, 2).End(xlUp).Row
If LaFeuille.Cells(i, 2) <> "" Then
If LaFeuille.Cells(i, 4).Value >= LaFeuille.Cells(i, 5).Value Then
LaFeuille.Rows(i).Delete
i = i - 1
Else
If LaFeuille.Cells(i, 5).Value >= LaFeuille.Cells(i, 6).Value Then
LaFeuille.Rows(i).Delete
i = i - 1
End If
End If
End If
Next i
LaFeuille.Cells(2, 9).FormulaR1C1 = "Delta"
LaFeuille.Cells(3, 9).FormulaR1C1 = "=RC[-3]-RC[-4]"
LaFeuille.Cells(3, 9).AutoFill Destination:=LaFeuille.Range("I3:I" & LaFeuille.Cells(Rows.Count, 2).End(xlUp).Row), Type:=xlFillDefault
LaFeuille.Columns("I:I").NumberFormat = "mm:ss"
Next
Encore merci
Bonjour à tous,
tu devrais changer de méthode.
Ajoute une colonne avec en formule
=OU(D2>=5;E2>=6)
Tu tries dessus, les VRAI se trouvent regroupés en bas.
Soit tu filtres sur VRAI pour supprimer les lignes visible avec specialcells, soit tu repères la 1ère avec Match() et tu supprimes jusqu'à la dernière
Toutes les lignes seront supprimées en 1 fois, ça se fera très rapidement.
eric
Merci, le forum pour vos réponses.
J'ai pas réussi a mettre en oeuvre ta solution eriic, mais le temps de traitement ne dépasse 4 minutes, ce qui est long mais supportable.
Merci je valide
Bonjour,
Ben oui. Pas de fichier = tu te débrouilles tout seul
Des fois avec succès, des fois moins.
eric
Bonjour,
Sans boucle mais comme te le conseille Eric
Sub Filtre()
Dim WBA As Workbook
Dim LaFeuille As Worksheet
Dim Plage As Range
Set WBA = ThisWorkbook
For Each LaFeuille In WBA.Worksheets
With LaFeuille
'formules en colonne I puisque inutile
.Cells(1, 9).Formula = "=OR(D1>=E1,E1>=F1)"
.Cells(1, 9).AutoFill .Range(.Cells(1, 9), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9))
'défini la plage sur la colonne I
Set Plage = .Range(.Cells(1, 9), .Cells(Rows.Count, 9).End(xlUp))
'filtre
Plage.AutoFilter 1, True
'supprime les lignes visible
Plage.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
'puis la colonne I
.Columns("I:I").Delete Shift:=xlToLeft
Plage.AutoFilter
.Cells(2, 9).Value = "Delta"
.Cells(3, 9).FormulaR1C1 = "=RC[-3]-RC[-4]"
.Cells(3, 9).AutoFill .Range("I3:I" & .Cells(.Rows.Count, 2).End(xlUp).Row), xlFillDefault
End With
Next LaFeuille
End Sub
bonjour le forum
pour ma part eriiic je suis souvent dans la seconde solution
merci theze je test cela
Hello theze, j'ai un gros gain de temps avec ta méthode mais du coût j'ai plus le même résultat final....
cf .doc
Ci joint Mon fichier original de traitement,
et ma modif avec le code de theze
Mais mon fichier de donnée fait 8 Mo
lien valable 21jours
Si tu a une idée d'ou peut provenir une telle différence, du coup je sais plus qu'elle macro choisir
Bonsoir theze,
En fait la formule avec le "=OR(D1>=E1,E1>=F1)"je n'est pas réussi à la faire fonctionner j'ai autant de donnée que de données initiales, la suppression et /ou le filtrage ne sont pas pris en compte. pour décembre j'ai toujours 22864 lignes en utilisant ta méthode ( si j'ai pas fait d'erreur)
Apres ma méthode il ne reste plus que 11021 lignes
j'ai joint tous mes fichiers de traitement sur le poste ci dessus. Je comprend pas pourquoi ca ne fonctionne pas alors que sur le " papier" toi et eriiic avez raison
je sens que dans pas longtemps je vais changer de pseudo et devenir la Buse du Vb
Bonne semaine à vous
Bonjour,
Tes colonnes sont au format texte, il te faut les passer au format standard si tu veux que les formules fonctionnent en colonnes I puis tes feuilles ne sont pas identiques, la feuille "Jan 17" est différente des autres. Voici le code modifié :
Sub Filtre()
Dim WBA As Workbook
Dim LaFeuille As Worksheet
Dim Plage As Range
Set WBA = ThisWorkbook
For Each LaFeuille In WBA.Worksheets
With LaFeuille
'passe les colonnes au format "Standard"
.Columns("D:F").NumberFormat = "General"
.Columns("I:I").NumberFormat = "General"
If LaFeuille.Name = "Jan 17" Then
'formules en colonne I puisque inutile
.Cells(14, 9).Formula = "=OR(D14>=E14,E14>=F14)"
.Cells(14, 9).AutoFill .Range(.Cells(14, 9), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9))
'défini la plage sur la colonne I
Set Plage = .Range(.Cells(13, 9), .Cells(Rows.Count, 9).End(xlUp))
Else
'formules en colonne I puisque inutile
.Cells(3, 9).Formula = "=OR(D3>=E3,E3>=F3)"
.Cells(3, 9).AutoFill .Range(.Cells(3, 9), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9))
'défini la plage sur la colonne I
Set Plage = .Range(.Cells(2, 9), .Cells(Rows.Count, 9).End(xlUp))
End If
'filtre
Plage.AutoFilter 1, True
'supprime les lignes visible
Plage.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
'puis la colonne I
.Columns("I:I").Delete Shift:=xlToLeft
.Cells(2, 9).Value = "Delta"
.Cells(3, 9).FormulaR1C1 = "=RC[-3]-RC[-4]"
.Cells(3, 9).AutoFill .Range("I3:I" & .Cells(.Rows.Count, 2).End(xlUp).Row), xlFillDefault
End With
Next LaFeuille
End Sub
Comme PC au boulot je n'ai pas une formule 1 et il a fallut 1 minute 30 secondes.
Bonjour Theze,
Merci c'est parfait,
j'ai juste modifié
Plage.AutoFilter 1, True
en
Plage.AutoFilter 1, "VRAIX"
Et le filtage est impécable.
Je valide,
A très bientôt sur le forum,
Avec "VRAIX" ça fonctionne !!!
c est cela merci