Discussion :

[tiplof]

bonjour,

pour gérer les redimensionnement d'un formulaire, j'ai écrit le petit bout de code ci dessous qui :
- insère de nouvelles lignes à un endroit précis
- copie / colle une plage de références, contenant des formules que je souhaite conserver
- remet à zéro les valeurs et validations de la plage copiée, au cas où il y ai des cellules complétées dans la plage de référence.

Le code ci dessous fonctionne... mais est horriblement lent (environ 25secondes sur mon pc pour 50 itérations de la boucle, lorsqu'il faut en faire 2000 je deviens fou).

Auriez vous des idées d'améliorations qui accélérerait le temps d’exécution ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
With ThisWorkbook.Worksheets(nomOnglet)
 For i = 1 To nbLignes
       'insertion puis copie / colle de la plage de référence
        rangeInsertion = "" & indexColonneDebutFormulaire & marqueurInsertionFormulaire & ":" & indexColonneFinFormulaire & marqueurInsertionFormulaire
        .Range(rangeInsertion).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range(plageFormulesReferenceFormulaire).Select
        Selection.Copy
        .Range("" & indexColonneDebutFormulaire & marqueurInsertionFormulaire).Select
       ActiveSheet.Paste
 
        'remise à zero de la ligne
        .Cells(marqueurInsertionFormulaire, 1).Value = ""
        .Cells(marqueurInsertionFormulaire, 3).Value = ""
        .Cells(marqueurInsertionFormulaire, 3).Validation.Delete
       .Cells(marqueurInsertionFormulaire, 5).Value = ""
        .Cells(marqueurInsertionFormulaire, 6).Value = ""
        .Cells(marqueurInsertionFormulaire, 8).Value = ""
        'etcetcetc
    Next i
End with

Mille mercis !!

[fring]

Bonjour,

Pour commencer tu peux éviter les Select
Cette partie de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
.Range(rangeInsertion).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(plageFormulesReferenceFormulaire).Select
Selection.Copy
.Range("" & indexColonneDebutFormulaire & marqueurInsertionFormulaire).Select
ActiveSheet.Paste

devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.Range(rangeInsertion).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(plageFormulesReferenceFormulaire).Copy .Range(indexColonneDebutFormulaire & marqueurInsertionFormulaire)

et en début de code, ajoute :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

[tiplof]

Merci pour ces pistes.

La suppression des select améliore un peu le temps de traitement, mais cela reste marginal (<2%). La mise à jour de l'affichage était déjà désactivée (je savais que j'avais oublié une précision dans mon message... toutes mes excuses!).

Le problème a mon avis est de faire une copie format + formule (ave mise à jour des références relatives des formules), mais sans contenu, sur une plage et le plus rapidement possible. J'ai essayé différentes techniques :
- tout copier puis écraser les .Value une par une : lent (a moins qu'il n'existe un .ClearXXX qui supprime la valeur mais conserve la formule ?)
- faire un pastespecial format puis copier des .FormulaLocal de cellule a cellule en faisant un replace sur les références de ligne... : plus rapide (dans les -25%) mais assez malpropre.
- jouer avec de l'autofill : je n'y arrive pas

Si vous avez d'autres idées...

[fring]

Essaie également en mettant en début de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationManual

et de remettre en automatique en fin de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationAutomatic

L'autofill est une bonne idée, aide toi de l'enregistreur de macro pour trouver comment l'utiliser en VBA