optimisation insertion de lignes en VBA

  • Initiateur de la discussion Initiateur de la discussion superromu
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S

superromu

Guest
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
898
Réponses
6
Affichages
736
  • Question Question
Microsoft 365 Cpier/coller en VBA
Réponses
7
Affichages
808
Réponses
33
Affichages
3 K
Retour