optimisation de code (tres simple le code mais je debute)

Version imprimable

voila le code suivant marche tres bien (il fait bien ce que je lui demande) mais le temps d'execution est, je pense pour le travail réalisé trop long.

J'ai commencé le vba hier soir à 22h donc je connais quasiment rien et je n'ai pas trouvé de réponse dans les tuto, les faq ou les questions déjà posés

En utilisant l'enregisteur de macro j'ai trouvé une fonction:
Selection.AutoFill Destination:=Range("A3:A7"), Type:=xlFillDefault
je pense que c'est plus rapide que mes boucles mais le probleme est que je dois faire des calculs sur des données non vide et je n'ai pas trouvé le moyen de l'utiliser convenablement avec un truc du genre:

Citation:

selectionner feuille(donnetemporaire 1)
selectionner A1
retour = 0

tant que retour != 1
si interventions.cellule 1 non vide et interventions.cellule 2 non vide

alors
appliquer formule
retour = 1

sinon
selectionner cellule suivante (offset(1,0)
fsi

selectionner dans la feuille donne temporaire toutes les cellules de la colonne A1 pour les cellules des colonnes 1 et 2 de la feuille interventions ne sont pas vide

selection autofill

selectionner feuille donnetemporaire
copier la colonne A
selectionner colonne B;D
coller

voici ma macro pour l'instant

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub miseenplacedelafeuille()
    'calcul le nombre de ligne
    Dim nombredeligne   As Integer
    Sheets("INTERVENTIONS").Activate
    nombredeligne = ActiveSheet.Range("A1").End(xlDown).Row
 
    'supprime les espaces dans les durées opératoires (cause des erreurs de calcul)
    Range("G2:L" & nombredeligne).Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
    'insere une nouvelle feuille sur laquelle
    'sera calculer puis copier (gain de temps) la premiere colonne
    'pour chaque type d'operation
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "donnée temporaire 1"
    ActiveSheet.Range("A1") = "hfin - heb"
    ActiveSheet.Range("E1") = "hsrt - hent"
    ActiveSheet.Range("I1") = "hdepbloc - harrbloc"
    Range("A2:L" & nombredeligne).Select
    Selection.NumberFormat = "h:mm;@"
 
    'insere une nouvelle feuille sur laquelle
    'sera calculer puis copier (gain de temps) les temps d'anesthesie
    'et les noms voulus
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "donnée temporaire 2"
 
 
    'insere une nouvelle feuille sur laquelle sera affiché les résultats
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Résultat"
 
End Sub
 
Sub calculdesdureeope()
    'calcul le nombre de ligne à partir de la premiere colonne, toujours pleine jusqu'à la fin
    Dim nombredeligne   As Integer
    Sheets("INTERVENTIONS").Activate
    nombredeligne = ActiveSheet.Range("A1").End(xlDown).Row
 
    Dim compteur As Integer 'declare un compteur pour les boucles
 
    Sheets("donnée temporaire 1").Select
 
    Range("A2").Select
    For compteur = 2 To nombredeligne
        If IsEmpty(Sheets("INTERVENTIONS").Cells(compteur, 7).Value) Or IsEmpty(Sheets("INTERVENTIONS").Cells(compteur, 8).Value) Then
            ActiveCell.Value = ""
        ElseIf Sheets("INTERVENTIONS").Cells(compteur, 7).Value < Sheets("INTERVENTIONS").Cells(compteur, 8).Value Then
             ActiveCell.FormulaR1C1 = "=((INT(INTERVENTIONS!R[0]C[7]/100)+(INTERVENTIONS!R[0]C[7]/100-INT(INTERVENTIONS!R[0]C[7]/100))*100/60)-(INT(INTERVENTIONS!R[0]C[6]/100)+(INTERVENTIONS!R[0]C[6]/100-INT(INTERVENTIONS!R[0]C[6]/100))*100/60))*60/1440"
        Else
             ActiveCell.FormulaR1C1 = "=((24 - (INT(INTERVENTIONS!R[0]C[7]/100)+(INTERVENTIONS!R[0]C[7]/100-INT(INTERVENTIONS!R[0]C[7]/100))*100/60))+(INT(INTERVENTIONS!R[0]C[6]/100)+(INTERVENTIONS!R[0]C[6]/100-INT(INTERVENTIONS!R[0]C[6]/100))*100/60))*60/1440"
        End If
 
        If IsEmpty(Sheets("INTERVENTIONS").Cells(compteur, 9).Value) Or IsEmpty(Sheets("INTERVENTIONS").Cells(compteur, 10).Value) Then
            ActiveCell.Offset(0, 4).Value = ""
        ElseIf Sheets("INTERVENTIONS").Cells(compteur, 9).Value < Sheets("INTERVENTIONS").Cells(compteur, 10).Value Then
            ActiveCell.Offset(0, 4).FormulaR1C1 = "=((INT(INTERVENTIONS!R[0]C[5]/100)+(INTERVENTIONS!R[0]C[5]/100-INT(INTERVENTIONS!R[0]C[5]/100))*100/60)-(INT(INTERVENTIONS!R[0]C[4]/100)+(INTERVENTIONS!R[0]C[4]/100-INT(INTERVENTIONS!R[0]C[4]/100))*100/60))*60/1440"
        Else
             ActiveCell.Offset(0, 4).FormulaR1C1 = "=((24 - (INT(INTERVENTIONS!R[0]C[5]/100)+(INTERVENTIONS!R[0]C[5]/100-INT(INTERVENTIONS!R[0]C[5]/100))*100/60)) + (INT(INTERVENTIONS!R[0]C[4]/100)+(INTERVENTIONS!R[0]C[4]/100-INT(INTERVENTIONS!R[0]C[4]/100))*100/60))*60/1440"
        End If
 
         If IsEmpty(Sheets("INTERVENTIONS").Cells(compteur, 11).Value) Or IsEmpty(Sheets("INTERVENTIONS").Cells(compteur, 12).Value) Then
            ActiveCell.Offset(0, 8).Value = ""
        ElseIf Sheets("INTERVENTIONS").Cells(compteur, 11).Value < Sheets("INTERVENTIONS").Cells(compteur, 12).Value Then
             ActiveCell.Offset(0, 8).FormulaR1C1 = "=((INT(INTERVENTIONS!R[0]C[3]/100)+(INTERVENTIONS!R[0]C[3]/100-INT(INTERVENTIONS!R[0]C[3]/100))*100/60)-(INT(INTERVENTIONS!R[0]C[2]/100)+(INTERVENTIONS!R[0]C[2]/100-INT(INTERVENTIONS!R[0]C[2]/100))*100/60))*60/1440"
        Else
             ActiveCell.Offset(0, 8).FormulaR1C1 = "=((24 - (INT(INTERVENTIONS!R[0]C[3]/100)+(INTERVENTIONS!R[0]C[3]/100-INT(INTERVENTIONS!R[0]C[3]/100))*100/60)) + (INT(INTERVENTIONS!R[0]C[2]/100)+(INTERVENTIONS!R[0]C[2]/100-INT(INTERVENTIONS!R[0]C[2]/100))*100/60))*60/1440"
 
        End If
 
    ActiveCell.Offset(1, 0).Select
    Next compteur
 
    Range("A1:A" & nombredeligne).Select
    Selection.Copy
    Range("B1:D" & nombredeligne).Select
    Selection.PasteSpecial Paste:=xlPasteValues
 
    Range("E1:E" & nombredeligne).Select
    Selection.Copy
    Range("F1:H" & nombredeligne).Select
    Selection.PasteSpecial Paste:=xlPasteValues
 
    Range("I1:I" & nombredeligne).Select
    Selection.Copy
    Range("J1:L" & nombredeligne).Select
    Selection.PasteSpecial Paste:=xlPasteValues
 
    Application.CutCopyMode = False
 
 
End Sub

voilamerci d'avance

16/04/2009, 18h24
laetitia

bonjour karlakir le forum j ai commencer a lire ta macro quand je suis arriver a la fin je me rappelles plus du debut (lol) zip un bout de ton fichier sans donnees confiden... pour voir + explications de ce que tu veus faire !!
16/04/2009, 20h24
karlakir

desole j'ai oublié de l'envoyer

le but de mon programme est de realiser un tableau croisé dynamique affichant la moyenne, le max, le min et l'écart type des durées par bloc et par jour

salut,
une petite proposition pour accelerer :
- mettre screenupdating = faux
- mettre le mode de calcul à manuel
- éviter les select qui ralentissent
- ne pas utiliser activecell.offset, mais désigner directement la cellule avec cells(n°Ligne, n°colonne)

je n'ai pas touché tes formules ni l'architecture générale, qui sans doute te conviennent. J'ai mis un affichage du n° ligne dans la StatusBar (en bas) pour pouvoir surveiller que ca avance

ce n'est surement pas archi-optimisé mais ca va déjà plus vite !

EDIT : pour quelqu'un qui a 24 h de VBA, je trouve que tu mérites des félicitations, donc :applo:

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Dim ShInter As Worksheet
Dim Shtemp1 As Worksheet
 
Sub calculdesdureeope()
    Dim nombredeligne   As Integer
    Dim compteur As Integer 'declare un compteur pour les boucles
    Dim oldStatusBar As Boolean
    'desactiver le calcul auto, le screen updating
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    'preparer l'affichage dans la barre de statut pour voir que ca avance
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
 
    ' instancier les feuilles pour une manipulation plus facile
    Set ShInter = Worksheets("INTERVENTIONS")
    Set Shtemp1 = Worksheets("donnée temporaire 1")
 
    nombredeligne = ShInter.Range("A1").End(xlDown).Row
 
    ' le compteur peut servir à désigner la ligne source et la ligne cible => pas besoin de offset(1,0)
    For compteur = 2 To nombredeligne
        Application.StatusBar = "ligne " & compteur
 
        If IsEmpty(ShInter.Cells(compteur, 7).Value) Or IsEmpty(ShInter.Cells(compteur, 8).Value) Then
            Shtemp1.Cells(compteur, 1).Value = ""
        ElseIf ShInter.Cells(compteur, 7).Value < ShInter.Cells(compteur, 8).Value Then
             Shtemp1.Cells(compteur, 1).FormulaR1C1 = "=((INT(INTERVENTIONS!R[0]C[7]/100)+(INTERVENTIONS!R[0]C[7]/100-INT(INTERVENTIONS!R[0]C[7]/100))*100/60)-(INT(INTERVENTIONS!R[0]C[6]/100)+(INTERVENTIONS!R[0]C[6]/100-INT(INTERVENTIONS!R[0]C[6]/100))*100/60))*60/1440"
        Else
             Shtemp1.Cells(compteur, 1).FormulaR1C1 = "=((24 - (INT(INTERVENTIONS!R[0]C[7]/100)+(INTERVENTIONS!R[0]C[7]/100-INT(INTERVENTIONS!R[0]C[7]/100))*100/60))+(INT(INTERVENTIONS!R[0]C[6]/100)+(INTERVENTIONS!R[0]C[6]/100-INT(INTERVENTIONS!R[0]C[6]/100))*100/60))*60/1440"
        End If
 
        If IsEmpty(ShInter.Cells(compteur, 9).Value) Or IsEmpty(ShInter.Cells(compteur, 10).Value) Then
            Shtemp1.Cells(compteur, 5).Value = ""
        ElseIf ShInter.Cells(compteur, 9).Value < ShInter.Cells(compteur, 10).Value Then
            Shtemp1.Cells(compteur, 5).FormulaR1C1 = "=((INT(INTERVENTIONS!R[0]C[5]/100)+(INTERVENTIONS!R[0]C[5]/100-INT(INTERVENTIONS!R[0]C[5]/100))*100/60)-(INT(INTERVENTIONS!R[0]C[4]/100)+(INTERVENTIONS!R[0]C[4]/100-INT(INTERVENTIONS!R[0]C[4]/100))*100/60))*60/1440"
        Else
             Shtemp1.Cells(compteur, 5).FormulaR1C1 = "=((24 - (INT(INTERVENTIONS!R[0]C[5]/100)+(INTERVENTIONS!R[0]C[5]/100-INT(INTERVENTIONS!R[0]C[5]/100))*100/60)) + (INT(INTERVENTIONS!R[0]C[4]/100)+(INTERVENTIONS!R[0]C[4]/100-INT(INTERVENTIONS!R[0]C[4]/100))*100/60))*60/1440"
        End If
 
         If IsEmpty(ShInter.Cells(compteur, 11).Value) Or IsEmpty(ShInter.Cells(compteur, 12).Value) Then
            Shtemp1.Cells(compteur, 9).Value = ""
        ElseIf ShInter.Cells(compteur, 11).Value < ShInter.Cells(compteur, 12).Value Then
             Shtemp1.Cells(compteur, 9).FormulaR1C1 = "=((INT(INTERVENTIONS!R[0]C[3]/100)+(INTERVENTIONS!R[0]C[3]/100-INT(INTERVENTIONS!R[0]C[3]/100))*100/60)-(INT(INTERVENTIONS!R[0]C[2]/100)+(INTERVENTIONS!R[0]C[2]/100-INT(INTERVENTIONS!R[0]C[2]/100))*100/60))*60/1440"
        Else
             Shtemp1.Cells(compteur, 9).FormulaR1C1 = "=((24 - (INT(INTERVENTIONS!R[0]C[3]/100)+(INTERVENTIONS!R[0]C[3]/100-INT(INTERVENTIONS!R[0]C[3]/100))*100/60)) + (INT(INTERVENTIONS!R[0]C[2]/100)+(INTERVENTIONS!R[0]C[2]/100-INT(INTERVENTIONS!R[0]C[2]/100))*100/60))*60/1440"
        End If
    Next compteur
 
    'refaire le calcul avant les copie/coller
    Application.Calculation = xlAutomatic
    Shtemp1.Calculate
 
    ' supprimer les select / selection
    Shtemp1.Activate
    Shtemp1.Range("A1:A" & nombredeligne).Copy
    Shtemp1.Range("B1:D" & nombredeligne).PasteSpecial Paste:=xlPasteValues
 
    Shtemp1.Range("E1:E" & nombredeligne).Copy
    Shtemp1.Range("F1:H" & nombredeligne).PasteSpecial Paste:=xlPasteValues
 
    Shtemp1.Range("I1:I" & nombredeligne).Copy
    Shtemp1.Range("J1:L" & nombredeligne).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
 
    ' et remettre le mode de calcul, le screen updating et la barre de statut
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
End Sub

19/04/2009, 16h43
karlakir

MEERRCCCCCIII :king:

j'ai appliqué ces techniques au reste des macros que j'ai ajouté (quand j'aurais "fini", je redemanderais quelques conseils sur comment les ameliorer encore un peu) et j'ai gagné plus de 30 secondes.

moins de 3 secondes à chaque fois que je lance l'ensemble des macros! :D