accélérer un code vba

[pascal21]

bonjour le forum
j'ai trouvé un bout de code sur le net qui fonctionne pour supprimer les lignes vides dont la colonne A n'est pas renseignée
mais il est dejà très long pour 1000 lignes lors de mon test (+ de 20 sec.)
alors qu'il faudrait que çà concerne 5000 lignes

Private Sub Worksheet_Activate()
Dim i%
    For i = 1000 To 1 Step -1
        If Cells(i, 1) = "" Then Rows(i).Delete
    Next i
End Sub

est-ce que vous auriez une solution plus rapide?
merci

 

[DoubleZero]

Bonjour à toutes et à tous,

Comme ceci ?

Option Explicit
Private Sub Worksheet_Activate()
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

A bientôt

 

[pierrejean]

Bonjour pascal21
Bises a DoubleZero

A tester:
Sub efface()
Dim zone As Range
For n = 1 To 1210
If Range("A" & n) = "" Then
If Not zone Is Nothing Then
Set zone = Application.Union(zone, Range(Cells(n, 1).Address & ":" & Cells(n, Columns.Count).Address))
Else
Set zone = Range(Cells(n, 1).Address & ":" & Cells(n, Columns.Count).Address)
End If
End If
Next
zone.Delete
End Sub

 

[pascal21]

bonjour double zero, pierre jean
double zero ce code je l'avais essayé et ça ne fonctionnait pas chez moi
c'est peut etre parceque les cellules à supprimer se trouvaient entre des autres
pierrejean ça fonctionne parfaitement
merci

 

[DoubleZero]

Re-bonjour, bises à pierrejean ,

... double zero ce code je l'avais essayé et ça ne fonctionnait pas chez moi... c'est peut etre parceque les cellules à supprimer se trouvaient entre des autres

Une fis de plus... nécessité de joindre un fichier exemple afin que nul ne perde son temps...

A bientôt

 

[laetitia90]

bonjour toutes & tous
bisous a mes ami(e)s DoubleZero & Pierrejean
le code de DoubleZero devrait marcher?? en modifiant un peu

ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

ou

On Error Resume Next
    [A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[job75]

Bonjour à tous,

Si le code de DoubleZero ne va pas c'est que vraisemblablement il y a en colonne A des formules renvoyant le texte vide "".

Ceci est très rapide :

Sub SupprimerLignesVides()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  .Columns(1).EntireColumn.Insert 'colonne auxiliaire
  .Columns(0) = "=1/(RC[1]<>"""")"
  .Columns(0) = .Columns(0).Value
  .Columns(0).Resize(, .Columns.Count + 1).Sort .Columns(0) 'tri pour accélérer
  On Error Resume Next
  .Columns(0).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(0).EntireColumn.Delete
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub

A+

 

[job75]

Re,

Sans insérer de colonne c'est un tout petit peu plus rapide :

Sub SupprimerLignesVides()
Dim cc%
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  cc = .Columns.Count
  .Columns(cc + 1) = "=1/(RC[" & -cc & "]<>"""")"
  .Columns(cc + 1) = .Columns(cc + 1).Value
  .Resize(, cc + 1).Sort .Columns(cc + 1) 'tri pour accélérer
  On Error Resume Next
  .Columns(cc + 1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(cc + 1) = ""
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub

A+