[XL-2003] Améliorer la vitesse d'une macro [Résolu]

[zalombo]

Bonjour

Je suis débutant en macro et j'ai un soucis de vitesse avec une macro qui mets une trentaine de seconde à s'exécuter.
En effet je dois faire la somme dans une feuille Excel de 65000 lignes, en fonction de 2 paramètres et il doit me ressortir la durée en heures.
Cette macro fonctionne bien mais mets un temps fort long pour m'afficher les résultats dans mon tableau.
Environ 100 lignes pour 15 colonnes.

Est-il possible d'accélerer la vitesse de cette macro?

Merci pour vos réponses

Voici le code:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
 
    For i = 6 To 160 Step 1
        i = 6
        For j = 3 To 30 Step 1
            If Cells(5, j) = "" Then
                Exit For
            End If
 
            Cells(i, j) = "=IF(RC2="""","""",IF(SUMPRODUCT(('Poste de travail'!R1C5:R65000C5=RC2)*('Poste de travail'!R1C10:R65000C10=R5C),('Poste de travail'!R1C8:R65000C8))=0,"""",SUMPRODUCT(('Poste de travail'!R1C5:R65000C5=RC2)*('Poste de travail'!R1C10:R65000C10=R5C),('Poste de travail'!R1C8:R65000C8))))"
            Cells(i, j).Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Next
 
        If Cells(i + 1, 2) = "" Then
 
        End If
 
 
    Next
End Sub

[corona]

Bonjour,
D'abord en début de procédure tu peux placer ce code

Code :

1
2
3
4
5
Dim flgCalcul As Integer
 With Application
  .ScreenUpdating = False
  flgCalcul = .Calculation
 End With

Et en fin de procédure celui-ci

Code :

1
2
3
4
With Application
  .ScreenUpdating = True
  .Calculation = flgCalcul
 End With

Maintenant, il y a une élément qui m'échappe, pourquoi alors que tu es dans une boucle, tu fais un Select sur la cellule sur laquelle tu es déjà (Cells(i, j).Select).
En plus c'est parfaitement inutile de faire une sélection sur une cellule.
Pourquoi ce Copy/Paste Special, y a-t-il une raison particulière ?

[alsimbad]

personelement, je ne comprend pas une boucle qui dit

Code :

1
2
3
4
 
For i = 6 To 160 Step 1
i = 6
next

[corona]

Bonjour,

Envoyé par alsimbad

personelement, je ne comprend pas une boucle qui dit

Code :

Ah, celle là m'a échappée

[zalombo]

Maintenant, il y a une élément qui m'échappe, pourquoi alors que tu es dans une boucle, tu fais un Select sur la cellule sur laquelle tu es déjà (Cells(i, j).Select).
En plus c'est parfaitement inutile de faire une sélection sur une cellule.
Pourquoi ce Copy/Paste Special, y a t'il une raison particulière ?

Le coller spécial valeur était une astuce qui me permettait de ne pas avoir la formule qui se répétaient des milliers de fois et qui ralentissait encore plus la macro.
comme je débute en macro, je ne comprends pas tout.

Envoyé par alsimbad

personelement, je ne comprend pas une boucle qui dit

Code :

Pour le I=6 c'était une erreur de frappe de ma part.

[corona]

Bonjour,
As-tu déjà essayé ce que je t'ai proposé.
Vois-tu une amélioration ?

[zalombo]

Oui j'ai essayé et je ne vois pas franchement de gain de temps.

Toujours environ 40s à s'éxecuter sur Excel 2003

[bbil]

Je ne comprends pas pourquoi écrire une formule dans excel si ensuite tu écrase cela par sa valeur ?

pour quoi ne pas effectuer directement le calcul en VBA et écrire dans le tableau le résultat du calcul ..?

[zalombo]

Envoyé par bbil

Je ne comprends pas pourquoi écrire une formule dans excel si ensuite tu écrase cela par sa valeur ?

pour quoi ne pas effectuer directement le calcul en VBA et écrire dans le tableau le résultat du calcul ..?

C'est un peu ce que je cherche à faire mais je ne sais pas comment m'y prendre

[Theze]

Bonsoir,

Une piste peut être ? Pas testé du tout :

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
 
Sub test()
 
    For i = 6 To 160
 
        For j = 3 To 30
 
            If Cells(5, j) = "" Then
                Exit For
            End If
 
            If Range("B" & i) <> "" Then
 
                With Worksheets("Poste de travail")
 
                    If SumProduct((.[E1:E65000] = Range("B" & i)) * (.[J1:J65000] = Range("E" & i)), (.[H1:H65000])) <> 0 Then
                        Cells(i, j) = SumProduct((.[E1:E65000] = Range("B" & i)) * (.[J1:J65000] = [E1]), (.[H1:H65000]))
                    End If
 
                End With
 
            End If
 
            'sinon au lieu du copier/coller tu peux affecter la valeur (pas testé mais je pense plus rapuide)
'            Cells(i, j) = "=IF(RC2="""","""",IF(SUMPRODUCT(('Poste de travail'!R1C5:R65000C5=RC2)*('Poste de travail'!R1C10:R65000C10=R5C),('Poste de travail'!R1C8:R65000C8))=0,"""",SUMPRODUCT(('Poste de travail'!R1C5:R65000C5=RC2)*('Poste de travail'!R1C10:R65000C10=R5C),('Poste de travail'!R1C8:R65000C8))))"
'            Cells(i, j).Value = Cells(i, j).Value
 
        Next
 
        If Cells(i + 1, 2) = "" Then
 
        End If
 
    Next
 
End Sub

Hervé.

[zalombo]

J'ai bien avancé sur l'amélioration de ma macro grâce à votre aide

Il me reste juste un dernier problème que je n'arrive pas à résoudre.
Dans ma formule il me rajoute des ' ' qui empêche le calcul

Code :

1
2
3
 
            ActiveCell.Formula = _
            "=SUMPRODUCT((('Poste de travail'!E" & LigneDeB & "):('Poste de travail'!E" & ligneFin & ")=RC2)*(('Poste de travail'!J" & LigneDeB & "):('Poste de travail'!J" & ligneFin & ")=R5C),(('Poste de travail'!H" & LigneDeB & "):('Poste de travail'!H" & ligneFin & ")))"

Le résultat sur EXcel donne la ligne suivante

=SOMMEPROD((('Poste de travail'!'E357'): ('Poste de travail'!'E1126')=$B6)*(('Poste de travail'!'J357'): ('Poste de travail'!'J1126')=C$5);(('Poste de travail'!'H357'): ('Poste de travail'!'H1126')))

Il m'écrit le paramètre E357 entre des guillemets et je ne comprends pas d’où cela peut venir.

Merci pour votre aide

[zalombo]

J'ai trouvé, il fallait juste que je rentre dans les formules les lignes et colonnes en R357C5 au lieu de E357.

Du coup ça marche

Et ça tourne en 3s