accélérer un code vba

pascal21 · 7 Janvier 2017

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

Code:

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 · 7 Janvier 2017

Bonjour à toutes et à tous,

Comme ceci ?

VB:

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

A bientôt 🙂

pierrejean · 7 Janvier 2017

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 · 7 Janvier 2017

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 · 7 Janvier 2017

Re-bonjour, bises à pierrejean 😀,

pascal21 à dit:
... 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 f🙄is de plus... nécessité de joindre un fichier exemple afin que nul ne perde son temps...

A bientôt 🙂

laetitia90 · 7 Janvier 2017

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

VB:

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

ou

VB:

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

job75 · 7 Janvier 2017

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 :

Code:

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 · 7 Janvier 2017

Re,

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

Code:

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+

accélérer un code vba

pascal21

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

pascal21

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

laetitia90

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires

accélérer un code vba

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency