Suppression des lignes vides : éxécution trop lente

Bonjour à tous,

Tout d'abord j'ai bien vu la macro de Sébastien permettant de gérer les doublons et les lignes vides.

J'utiliserais bien cette macro mais le problème est que je n'arrive pas à la lancer avec application.run , un message d'erreur apparait. Enfin là n'est pas le problème.

Mon code actuel est le suivant :

Sub supp ()

Dim n As Integer

Application.ScreenUpdating = False

For n = 24000 To 1 Step -1

If (Range("A" & n) = "") Then

Rows(n).Delete

End If

Next n

Application.ScreenUpdating = True

End sub

(mon tableau dépasse jamais 24 000 lignes)

Mon problème est que cette macro met environ 2 minutes à s’exécuter, j'ai tester avec la macro proposer par Sébastien et le temps d’exécution est de a peine 2 secondes. J'ai donc tenter de modifier son code mais sans succès.

Voilà, si quelqu'un a une idée ça me rendrais bien service.

bonsoir,

Peut-être que tu as beaucoup moins de 24000 lignes donc si tu n'as qu'une centaine de lignes dans ton tableau, la macro commence par supprimer les 23900 lignes vides inutiles en fin de tableau avant d'attaquer la partie utile du tableau et les quelques lignes ou il y a vraiment quelque chose à supprimer...

Dans ce cas faut donc commencer par déterminer avec plus de précision la zone utile à examiner. Mais cela ne peut se faire qu'au vu de ton classeur. (débarrassé des éléments confidentiels)

A+

Merci pour ta réponse, mais a 24000 j'ai déjà réduit, j'ai jusqu'a 2000 lignes par mois, et je fait un tableau récap de l'année, je met mes données en une colonne, et je lance la macro.

Bonjour

J'ai cherché un peu et voici

La 1ère macro est un peu longue si beaucoup de trous dans la liste

Sub Suppression()
  Application.ScreenUpdating = False
  On Error Resume Next
  Range("N1:N24000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0             ' Pas utile
End Sub

La suivante est plus rapide

Sub SuppressionBis()
  Application.ScreenUpdating = False
    With ActiveSheet.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("N1:N24000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .SetRange Range("N1:N24000")      ' Ecrire ta plage
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
   End With

  On Error Resume Next
  Range("N1:N24000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0             ' Pas utile

End Sub

Bonsoir,

Conserve l'ordre initial

Sub supLignesRapide2()
  Application.ScreenUpdating = False
  a = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

Ceuzin

Merci à vous pour vos réponses, Ceuzin c'est super ça marche impeccable.