Macro VBA très lente

Fermé
jonleyva Messages postés 4 Date d'inscription mercredi 27 août 2008 Statut Membre Dernière intervention 22 novembre 2010 - 22 nov. 2010 à 18:11
eriiic Messages postés 24600 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 21 octobre 2024 - 22 nov. 2010 à 23:43
Bonjour,

J'ai un code qui permet de remplir des cellules vide dans une plage. Le problème étant la vitesse d'execution.

Je précise qu'il s'agit quand même d'un fichier de 15 colonnes fois 115 000 lignes (Excel 2007)

Voici le code:

Sub Remplir()
Dim cel As Range

ActiveSheet.Range("A1").CurrentRegion.Select

For Each cell In Selection
If cell.Value = "" Then
cell.Value = cell.Offset(-1, 0).Value
Else
End If
Next cell

End Sub

Quelqu'un aurait une idée d'amélioration?

Je vous remercie tous d'avance

Cordialement

A voir également:

2 réponses

Gord21 Messages postés 918 Date d'inscription samedi 21 novembre 2009 Statut Membre Dernière intervention 20 mars 2013 289
22 nov. 2010 à 20:33
Bonsoir,
Tu peux essayer :

Sub Remplir() 
Dim cel As Range 
ActiveSheet.Range("A1").CurrentRegion.Select 
Application.ScreenUpdating=False
For Each cell In Selection 
   If cell.Value = "" Then 
      cell.Value = cell.Offset(-1, 0).Value 
   End If 
Next cell 
Application.ScreenUpdating = True
End Sub 


@+
0
eriiic Messages postés 24600 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 21 octobre 2024 7 238
22 nov. 2010 à 23:43
Bonsoir,

Une autre proposition, la lecture de données se faisant par bloc (par colonne) pour accélérer un peu plus si les trous ne sont pas majoritaires :
Sub Remplir()
    Dim pl As Range, col As Long, lig As Long, datas
    Set pl = ActiveSheet.Range("A1").CurrentRegion
    Application.ScreenUpdating = False
    For col = 1 To pl.Columns.Count
        datas = pl.Columns(col)
        For lig = 2 To UBound(datas)
            If datas(lig, 1) = "" Then
                pl(lig, col) = pl(lig - 1, col)
            End If
        Next lig
    Next col
    Application.ScreenUpdating = True
End Sub


eric
0