Supprimer lignes vides

[nonoTT]

bonjour j'ai essayé deux macros pour supprimer des lignes vides dans un fichier excel.
Le problème est que le fichier est très volumineux avec beaucoup de lignes (+ de 15000) et donc la macro prend beaucoup de temps.
Macro 1 :

Sub supprimelignesvides()
  Dim i As Long
  
  For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
      If Application.CountA(Rows(i)) = 0 Then Rows(i).Delete
  Next i
  
  End Sub

ou macro 2:

Sub SuppLigneVides()
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

Avez vous une solution plus rapide ?
Cordialement

 

[phlaurent55]

Re : Supprimer lignes vides

Bonjour nono

en ajoutant :
Application.ScreenUpdating = False
au début de ton code
sans oublier de le remettre à True à la fin du code

à+
Philippe

 

[nonoTT]

Re : Supprimer lignes vides

C'est toujours très long !
cordialement.

 

[phlaurent55]

Re : Supprimer lignes vides

Re,

ajoute
Application.Calculation = xlCalculationManual au début du code
et
application.Calculation=xlCalculationAutomatic en fin de code

tout en conservant les lignes Application.ScreenUpdating=.........


ou alors, mettre le fichier en pièce jointe pour pouvoir tester
à+
Philippe

 

[Robert]

Re : Supprimer lignes vides

Bonjour nonoTT, Philippe, bonjour le forum,

Peut-ête en passant par un tableau... À tester.

Sub supprimelignesvides()
Dim i As Range 'déclare la variable i (lIgne)
Dim lv() As Long 'déclare le tableau de variables lv (Lignes Vides)
Dim x As Long 'déclarela variable x (incrément)
Dim pl As Range 'déclare la variable pl (PLage)

For Each i In ActiveSheet.UsedRange.Rows 'boucle sur toutes les lignes de la plage utilisée de l'onglet actif
    If Application.CountA(i) = 0 Then 'condition : si la ligne est vierge
        ReDim Preserve lv(x) 'redimentionne le tableau des lignes vides lv
        lv(x) = i.Row 'récupère le numéro de la ligne vide
        x = x + 1 'incrémente x
    End If 'fin de la condition
Next i 'prochaine ligne de la boucle
For x = LBound(lv) To UBound(lv) 'boucle sur toutes les lignes vide du tableau lv
    If pl Is Nothing Then 'condition : si la plage pl n'est pas vide
        Set pl = Rows(lv(x)) 'définit la plage pl
    Else 'sinon
        Set pl = Application.Union(pl, Rows(lv(x))) 're'definit la plage pl
    End If 'fin de la condition
Next x 'prochaine ligne vide dutableau lv
pl.Delete 'supprime la plage pl
End Sub

 

[flyonets44]

Re : Supprimer lignes vides

bonjour
Deux solutions possibles
la première est de trier toute de base de données en choisissant un critère de tri
la seconde avec ce code à tester

Sub Supprimer_Lignes_Vides()
Dim derligne As Long, ligne As Long, Plage As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
derligne = Cells(Application.Rows.Count, 1).End(xlUp).Row
For ligne = derligne To 1 Step -1
  If Application.WorksheetFunction.CountBlank(Cells(ligne, 1).Resize(, 256)) = vbnullstring Then
    If Plage Is Nothing Then
      Set Plage = Rows(ligne)
    Else
      Set Plage = Union(Plage, Rows(ligne))
    End If
  End If
Next ligne
If Not Plage Is Nothing Then Plage.EntireRow.Delete
Application.EnableEvents = True
Application.ScreenUpdating = True
Set Plage =Nothing
End Sub

Cordialement
Flyonets

 

[BOISGONTIER]

Re : Supprimer lignes vides

Bonjour,

Voir PJ

-Principe: placer les lignes vides à la fin
-0,5s pour 20.000 lignes vides sur toutes les colonnes
-Ne modifie pas l'ordre initial.

Sub supLignesRapide()
  Application.ScreenUpdating = False
  n = [A65000].End(xlUp).Row
  Dim a()
  ReDim a(1 To n)
  For i = 2 To n
    If Application.CountA(Rows(i)) = 0 Then a(i) = "sup" Else a(i) = 0
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B1].Resize(n) = Application.Transpose(a)
  [A1].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

Si le test se fait sur la colonne A seulement: If Cells(i, 1) = "" Then a(i) = "sup" Else a(i) = 0


JB

 

[DoubleZero]

Re : Supprimer lignes vides

Bonjour, nonoTT, Philippe , Robert , le Forum,

Et ainsi ?

Sub Lignes_vides_supprimer()
Application.ScreenUpdating = 0
Application.Calculation = xlCalculationManual
[a:a].SpecialCells(xlCellTypeBlanks).Rows.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = -1
End Sub

A bientôt

Bonjour, BOISGONTIER

 

[Lone-wolf]

Re : Supprimer lignes vides

Bonsoir à tous

@ 00 : effectivement, elle est plus rapide.


A+

 

[sebgatz]

Re : Supprimer lignes vides

Je sais que ce topic est un peux vieux mais je rebondis dessus, on ne sait jamais.

Dans la macro de DoubleZero, comment faire pour que la suppression soit effectué sur la valeur 0 au lieu de cellules vides? (avec un test sur la colonne U)

idem pour celle de Boisgontier



Merci à tous pour vos réponses

 

[phlaurent55]

Re : Supprimer lignes vides

Bonjour seb

avec le code de Double00, essaie ceci:

[a:a].SpecialCells(xlNumbers,0).Rows.Delete

je n'ai pas testé

à+
Philippe

 

[BOISGONTIER]

Re : Supprimer lignes vides

Bonsoir,


Voir PJ

Sub supLignesRapide2()
  Application.ScreenUpdating = False
  a = Range("u1:u" & [u65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) = 0 Then a(i, 1) = "sup" Else a(i, 1) = 0
  Next i
  Columns("v:v").Insert Shift:=xlToRight
  [v1].Resize(UBound(a)) = a
  [v1].CurrentRegion.Sort Key1:=Range("v2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("v1:v65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("v:v").Delete Shift:=xlToLeft
End Sub


Sub sup0()
  [u:u].Replace 0, ""
  [u:u].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

JB

 

[sebgatz]

Re : Supprimer lignes vides

Merci à tous, je vais de ce pas tester ces macros