XL 2013 Mod 2 - une ligne sur deux lent sur 15000 lignes

GADENSEB

XLDnaute Impliqué
Bonjour,
Voici un fichier exemple (dans l'original il y a 15000 lignes)
Mon code est lent pour ce volume

Est-ce qu'il peut être amélioré ?

Code:
Sub Couleur()

For Each C In Range("A2:T" & Range("A65536").End(xlUp).Row)
If C.Row Mod 2 Then
C.Interior.ColorIndex = 15
Else
C.Interior.ColorIndex = xlNone
End If
Next

End Sub

Merci à tous

Seb
 

Pièces jointes

  • mod.xlsm
    14.9 KB · Affichages: 40

pierrejean

XLDnaute Barbatruc
Bonjour GADENSEB

Macro a tester
NB A mettre de préférence dans un module

Code:
Sub test()
debut = Timer
  Cells.Interior.ColorIndex = xlNone
Dim zone As Range
For n = 2 To Cells(Rows.Count, 1).End(xlUp).Row
 If n Mod 2 = 0 Then
  If Not zone Is Nothing Then
     Set zone = Application.Union(zone, Range("A" & n & ":" & "T" & n))
  Else
     Set zone = Range("A" & n & ":" & "T" & n)
  End If
End If
Next
zone.Interior.ColorIndex = 15
MsgBox (Timer - debut)
End Sub
 

job75

XLDnaute Barbatruc
Bonjour GADENSEB, Pierre,

@ Pierre, Union pédale dans la choucroute si le nombre de plages disjointes traitées dépasse quelques centaines.

Ceci est rapide :
Code:
Sub Couleur()
Application.ScreenUpdating = False
With Range("A1:T" & Cells(Rows.Count, 1).End(xlUp).Row)
  .Columns(1).Insert xlToRight
  .Columns(0) = "=1/MOD(ROW(),2)"
  Intersect(.Columns(0).SpecialCells(xlCellTypeFormulas, 16).EntireRow, .Cells).Interior.ColorIndex = 15
  .Columns(0).Delete xlToLeft
End With
End Sub
Mais le plus rapide consiste à appliquer la couleur par MFC, c'est très classique.

A+
 

Discussions similaires

Réponses
6
Affichages
132
Réponses
2
Affichages
148

Statistiques des forums

Discussions
312 206
Messages
2 086 203
Membres
103 157
dernier inscrit
youma