[VBA] Blocage dans une boucle... sans message d'erreur
Le
HD
Bonjour,
J'effectue une boucle afin de supprimer des lignes qui ne me conviennent pas
dans un classeur. Le classeur en question comporte plus de 13 000 lignes.
Mon souci est que alors que je fais pourtant apparaitre dans la barre de
statut l'avancement du travail l'écran va se figer et Excel va afficher ne
répond pas (il me faut appuyer briévement sur Echap pour revoir la barre de
statut défilée) mon autre souci est que plus la macro avance et plus le
défilement ralentit. Je pense que le souci vient du fait que la variable
Plage contient de plus en plus de donnée (sur les 13000 lignes il y'a
environ 7000 lignes de supprimées)
Voici mon script :
--
Dim i As Long
Dim lMax As Long
Dim cMax As Long
Dim Plage As Range
lMax = ActiveSheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
cMax = ActiveSheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Application.ScreenUpdating = False
Application.EnableEvents = False
Set Plage = Nothing
i = 8
Do
Application.StatusBar = i & " / " & lMax
If Cells(i, 2).Value <> 280 Then
If Plage Is Nothing Then
Set Plage = Range(Cells(i, 1), Cells(i, cMax))
Else
Set Plage = Union(Plage, Range(Cells(i, 1), Cells(i, cMax)))
End If
End If
i = i + 1
Loop Until Cells(i, 2).Value = ""
Plage.Delete
Set Plage = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
--
Merci d'avance pour votre aide,
Cordialement,
@+
HD
J'effectue une boucle afin de supprimer des lignes qui ne me conviennent pas
dans un classeur. Le classeur en question comporte plus de 13 000 lignes.
Mon souci est que alors que je fais pourtant apparaitre dans la barre de
statut l'avancement du travail l'écran va se figer et Excel va afficher ne
répond pas (il me faut appuyer briévement sur Echap pour revoir la barre de
statut défilée) mon autre souci est que plus la macro avance et plus le
défilement ralentit. Je pense que le souci vient du fait que la variable
Plage contient de plus en plus de donnée (sur les 13000 lignes il y'a
environ 7000 lignes de supprimées)
Voici mon script :
--
Dim i As Long
Dim lMax As Long
Dim cMax As Long
Dim Plage As Range
lMax = ActiveSheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
cMax = ActiveSheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Application.ScreenUpdating = False
Application.EnableEvents = False
Set Plage = Nothing
i = 8
Do
Application.StatusBar = i & " / " & lMax
If Cells(i, 2).Value <> 280 Then
If Plage Is Nothing Then
Set Plage = Range(Cells(i, 1), Cells(i, cMax))
Else
Set Plage = Union(Plage, Range(Cells(i, 1), Cells(i, cMax)))
End If
End If
i = i + 1
Loop Until Cells(i, 2).Value = ""
Plage.Delete
Set Plage = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
--
Merci d'avance pour votre aide,
Cordialement,
@+
HD
Si j'ai bien compris......
Ceci prend en compte un tableau commençant à la ligne 8 jusqu'a la dernière ligne de la feuille active
Supprime les lignes dont la valeur en colonne B est <> de 280
'----------------------
Sub jj()
Dim i As Long
Dim LMax As Long
LMax = ActiveSheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = LMax To 8 Step -1
Application.StatusBar = i & " / " & LMax
If Cells(i, 2).Value <> 280 Then
Rows(Cells(i, 2).Row).Delete
End If
Next
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'------------------
--
Salutations
JJ
"HD"
C'est bien ça. Sauf qu'en fait plutôt que de supprimer ligne à ligne lorsque
la suppression répond au critère je préfère mettre les lignes à supprimer
dans une plage pour tout supprimer à la fin car c'est beaucoup plus rapide.
J'ai trouvé pourquoi la macro avait des réactions bizarres... avec gèle
d'écran et ralentissements excessifs... Honte à moi, j'ai cliqué à un moment
donné pour enregistrer une macro manuellement et... j'ai dû être appelé et
lorsque je suis revenu je n'ai plus pensé à l'enregistrement de macro que
j'avais lancée. D'où les ralentissements d'Excel...
@+
HD
Si tu veux quelque chose de performant, essaie ceci :
'------------------------------------------------
Sub Test()
Dim i As Long, lMax As Long
Dim Plage As Range, cMax As Long
With Feuil1 ' ActiveSheet
lMax = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
cMax = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set Plage = .Range("A1", .Cells(lMax, cMax))
End With
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
With Plage
.AutoFilter field:=2, Criteria1:="<>280"
.SpecialCells(xlCellTypeVisible).Delete
.AutoFilter
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
'------------------------------------------------
MichD
---------------------------------------------------------------
aux critères, cette ligne de code va prendre de plus en plus de temps
à s'exécuter.
Set Plage = Union(Plage, Range(Cells(i, 1), Cells(i, cMax)))
Dans la mesure du possible, on réserve cette approche sur des
petites plages de cellules où lorsque l'on sait d'avance qu'il y a
peu de cellules qui répondent au critère.
Lorsque tu peux utiliser le filtre, c'est beaucoup plus rapide
qu'une boucle!
MichD
---------------------------------------------------------------
choses.
Un grand MERCI à vous de m'avoir aidé.
Cordialement,
@+
HD