optimisation insertion de lignes en VBA

superromu

XLDnaute Nouveau
Bonjour,

y a t il un moyen d optimiser l insertion de ligne blanche sous Excel, et VBA ?
en fait je regarde un index et si celui ci change, j ajoute un ligne blanche

Start = Timer
' ajout d 'une ligne blanche entre chq vulnerabilité
ajout = 0
For Each c In Worksheets('feuille1').Range(Worksheets('feuille1').Cells(3, 1), _
Worksheets('feuille1').Cells(nb_ligne_total, 1))

If Worksheets('feuille1').Cells(c.Row, 1).Value <> _
Worksheets('feuille1').Cells(c.Row + 1, 1).Value And ajout = 0 Then

Worksheets('feuille1').Cells(c.Row + 1, 1).EntireRow.Insert
Worksheets('feuille1').Cells(c.Row + 1, 1).EntireRow.Interior.ColorIndex = 0
Worksheets('feuille1').Cells(c.Row + 1, 1).EntireRow.Borders.LineStyle = 0
ajout = 1

Else
ajout = 0
End If

Next

finish = Timer
tps_ajout = finish - Start

c est un tableau de 70 entrees environ et une 15aine d ajouts de lignes (c est un tableau dynamique donc assez variable)

le tps est d environ 2 secondes
ce qui est un peu long je trouve .

Merci de vos reponses
Romuald
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour Romuald, le Forum

En fait dès que l'on 'touche' à la feuille tout ralentit... Mais pour faire des insertions de Lignes, il faut bien passer par la Feuille et y 'toucher'...

Donc sur un tableau de 100 lignes avec une 20éne d'insertions je suis descendu à 50 centième de seconde simplement en optimisant l'écriture du code :

Option Explicit

Sub TheInsertor()
Dim Cell As Range, Plage As Range
Dim Start As Double
Dim Ajout As Byte
Dim nb_ligne_total As Long

Start = Timer

With Worksheets('Sheet2')
&nbsp; &nbsp; nb_ligne_total = .Range('A65536').End(xlUp).Row
&nbsp; &nbsp;
Set Plage = .Range(.Cells(3, 1), .Cells(nb_ligne_total, 1))
&nbsp; &nbsp; Ajout = 0
&nbsp; &nbsp; &nbsp; &nbsp;
For Each Cell In Plage
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
If .Cells(Cell.Row, 1).Value <> .Cells(Cell.Row + 1, 1).Value And Ajout = 0 Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
With .Cells(Cell.Row + 1, 1).EntireRow
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Insert
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Interior.ColorIndex = 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Borders.LineStyle = 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
End With
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ajout = 1
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
Else
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Ajout = 0
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
End If
&nbsp; &nbsp; &nbsp; &nbsp;
Next
End With

MsgBox Timer - Start
End Sub

Si ça peut te faire aller plus vite...
Bon Appétit
@+Thierry
 

Discussions similaires

Réponses
0
Affichages
181
Réponses
6
Affichages
301

Statistiques des forums

Discussions
312 572
Messages
2 089 819
Membres
104 284
dernier inscrit
Yohan90