Accélérer une Macro

Version imprimable

Accélérer une Macro

Bonjour

Voilà je voulais savoir s'il y avait un moyen afin que ma macro s’exécute plus rapidement. Cela vient certainement d'une erreur de ma part mais dès que je demande d'inscrire des formules je trouve que l’exécution n'est pas rapide,(peut être est ce normal ou pas.)
Donc si vous aviez un conseil.

Merci d'avance.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub CB_Valider_Click()
Application.CutCopyMode = True
Worksheets("Personnel").Activate
Range("A10000").End(xlUp).Offset(1, 0).Select
 
ActiveCell = New_Collegue.TB_Nom & " " & New_Collegue.TB_Prenom
 
 
ActiveCell.Offset(0, 1) = Me.CB_Service
ActiveCell.Offset(0, 2) = Me.CB_Planning
 
'Temps de Travail
ActiveCell.Offset(0, 3).FormulaR1C1 = _
        "=INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),11,3,RIGHT(RC3,1))"
'Total Semaine
    ActiveCell.Offset(0, 4).FormulaR1C1 = _
        "=INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),10,6,RIGHT(RC3,1))"
'Droit Nbre de jour de CP
    ActiveCell.Offset(0, 5).FormulaR1C1 = _
        "=INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),12,6,RIGHT(RC3,1))"
'Horaires semaine
    ActiveCell.Offset(0, 6).FormulaR1C1 = _
        "=TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),3,2,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),3,3,RIGHT(RC3,1)),""h:mm"")&""/""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),3,4,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),3,5,RIGHT(RC3,1)),""h:mm"")"
    ActiveCell.Offset(0, 7).FormulaR1C1 = _
        "=TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),4,2,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),4,3,RIGHT(RC3,1)),""h:mm"")&""/""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),4,4,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),4,5,RIGHT(RC3,1)),""h:mm"")"
    ActiveCell.Offset(0, 8).FormulaR1C1 = _
        "=TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),5,2,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),5,3,RIGHT(RC3,1)),""h:mm"")&""/""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),5,4,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),5,5,RIGHT(RC3,1)),""h:mm"")"
    ActiveCell.Offset(0, 9).FormulaR1C1 = _
        "=TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),6,2,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),6,3,RIGHT(RC3,1)),""h:mm"")&""/""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),6,4,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),6,5,RIGHT(RC3,1)),""h:mm"")"
    ActiveCell.Offset(0, 10).FormulaR1C1 = _
        "=TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),7,2,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),7,3,RIGHT(RC3,1)),""h:mm"")&""/""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),7,4,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),7,5,RIGHT(RC3,1)),""h:mm"")"
    ActiveCell.Offset(0, 11).FormulaR1C1 = _
        "=TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),8,2,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),8,3,RIGHT(RC3,1)),""h:mm"")&""/""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),8,4,RIGHT(RC3,1)),""h:mm"")&""-""&TEXT(INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),8,5,RIGHT(RC3,1)),""h:mm"")"
 
Application.CutCopyMode = False
Unload Me
End Sub

Bonjour

Des habitudes à prendre en considération: Éviter les Select/ Activate/ Activemachin...

Exemple pour ton code.

On peut même déscativer le calcul automatique et ne recalculer la feuille qu'à la fin

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub CB_Valider_Click()
Dim NewLig As Long
 
Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
With Worksheets("Personnel")
    NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
 
    .Cells(NewLig, 1) = New_Collegue.TB_Nom & " " & New_Collegue.TB_Prenom
    .Cells(NewLig, 2) = Me.CB_Service
    .Cells(NewLig, 3) = Me.CB_Planning
 
    'Temps de Travail
    .Cells(NewLig, 4).FormulaR1C1 = "=INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),11,3,RIGHT(RC3,1))"
    'Total Semaine
    .Cells(NewLig, 5).FormulaR1C1 = "=INDEX((PLANNING_1,PLANNING_2,PLANNING_3,PLANNING_4,PLANNING_5,PLANNING_6,PLANNING_7,PLANNING_8),10,6,RIGHT(RC3,1))"
    'Droit Nbre de jour de CP
    '.......
End With
'Application.Calculate
'Application.Calculation = xlCalculationAutomatic
 
Unload Me
End Sub

07/05/2018, 13h50
Didpa

Merci de t'être intéressé au pb. J'ai essayé ta macro, et cela ne change pas grand chose en terme de vitesse d’exécution.

Cordialement
07/05/2018, 15h30
el_slapper

Tu as essayé d'activer les lignes Application.Calcul ???
07/05/2018, 16h16
Pierre Fauconnier

Salut.

Puisque tu passes des formules, essaie déjà de le faire en Excel. Ca rame aussi? si oui => ce n'est pas un problème VBA.

Je suis assez dubitatif sur des concaténations de valeurs récupérées par INDEX.

Dès lors, ma question serait: Quelle est l'organisation de tes données? Qu'est censé récupérer INDEX? Pousses-tu ces données dans un tableau structuré?

Deux ou trois copies d'écran nous aiderait à y voir plus clair.
09/05/2018, 08h54
Didpa

Bonjour

Mr Fauconnier : "Je suis assez dubitatif sur des concaténations de valeurs récupérées par INDEX." je sais qu'il existe une autre manière de chercher en nomant mes tableaux, mais je ne maîtrise pas tout .....lol. Mais avec le temps j'essaierais de l'améliorer. Sinon cela ne ralenti pas la procédure quand je passe directement par excel.

Effectivement une fois les lignes d'application calcul activées, cela fonctionne. Encore merci.

Si je peux me permettre car la macro fonctionne bien, j'ai voulu l'adapter à une autre partie de ma programmation, et je bloque juste (sur le début, je ne trouve pas la solution, certainement simple pour vous...)

Je m'explique
Est ce qu'il existe une autre façon de remplir cela, sachant que j'ai 8 colonnes avec 8 formules différentes, peut être qu'avec ta méthode cela accélérerais le processus. Quand la macro se lance la ligne est active.

activecell.offset(0, 6).FormulaR1C1 = _
"=IF(OR(ISTEXT(RC6),COUNTIF(Fer,RC2)),"""",INDEX(R3C[57]:R9C[57],MATCH(TEXT(RC2,""jjjj""),R3C63:R9C63,0)))"

Voici un bout de la macro qui est répété 8 fois.

If Horaires.TB_Debmat = "" Then
activecell.offset(0, 5).FormulaR1C1 = _
"=IF(OR(ISTEXT(RC6),COUNTIF(Fer,RC2)),"""",INDEX(R3C[57]:R9C[57],MATCH(TEXT(RC2,""jjjj""),R3C63:R9C63,0)))"
Else
activecell.offset(0, 5) = Format(Horaires.TB_Debmat, "hh:mm")
activecell.offset(0, 5).Font.ColorIndex = 3
End If

Cordialement

Merci d'avance.