Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel optimiser une macro

optimiser une macro

26 réponses
Avatar
ptck
bonsoir

Dans le fichier joint j'ai une macro qui fait le total par nom et rubrique
qui marche
mais elle est un peu longue. Débutant en macro, je pense qu'elle n'est pas
efficace
peut elle être améliorée?
Merci de votre aide
ptck


http://www.cijoint.fr/cjlink.php?file=cj200906/cijJ3Zrdf9.xls
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
Fredo P.
http://www.cijoint.fr/cjlink.php?file=cj200906/cijkBynDod.xls
"ptck" a écrit dans le message de news:

bonsoir
je voulais savoir si on pouvait optimiser le code
merci


"garnote" a écrit dans le message de news:

Bonsoir,

Essaie ces formules et dis-moi si tu obtiens le résultat attendu.

Sur la feuille récap global :
1) Sélectionne B2:P21, entre cette formule
=SOMMEPROD((récap!$A$2:$A$215=$A2)*(récap!B2:B215))
et valide par Ctrl+Entrée.

2) Entre cette formule =SOMME(B2:P2) en Q2 et recopie jusqu'en Q21.

Serge


"ptck" a écrit dans le message de news:





bonsoir

Dans le fichier joint j'ai une macro qui fait le total par nom et
rubrique qui marche
mais elle est un peu longue. Débutant en macro, je pense qu'elle n'est
pas efficace
peut elle être améliorée?
Merci de votre aide
ptck


http://www.cijoint.fr/cjlink.php?file=cj200906/cijJ3Zrdf9.xls












Avatar
Fredo P.
Il est parti plus vite que je l'aurrait voulu
La sub est rétrécie et optimisée, j'ai aussi dévelopé le résultat à l'aide
de formules, c'est relativement simple aussi.
http://www.cijoint.fr/cjlink.php?file=cj200906/cijkBynDod.xls

"ptck" a écrit dans le message de news:

bonsoir
je voulais savoir si on pouvait optimiser le code
merci


"garnote" a écrit dans le message de news:

Bonsoir,

Essaie ces formules et dis-moi si tu obtiens le résultat attendu.

Sur la feuille récap global :
1) Sélectionne B2:P21, entre cette formule
=SOMMEPROD((récap!$A$2:$A$215=$A2)*(récap!B2:B215))
et valide par Ctrl+Entrée.

2) Entre cette formule =SOMME(B2:P2) en Q2 et recopie jusqu'en Q21.

Serge


"ptck" a écrit dans le message de news:





bonsoir

Dans le fichier joint j'ai une macro qui fait le total par nom et
rubrique qui marche
mais elle est un peu longue. Débutant en macro, je pense qu'elle n'est
pas efficace
peut elle être améliorée?
Merci de votre aide
ptck


http://www.cijoint.fr/cjlink.php?file=cj200906/cijJ3Zrdf9.xls












Avatar
garnote
Salut Fredo,

Celle-ci me semble correct aussi :
http://www.cijoint.fr/cjlink.php?file=cj200906/cijabbWmqo.xls

Serge



"Fredo P." a écrit dans le message de news:

Il est parti plus vite que je l'aurrait voulu
La sub est rétrécie et optimisée, j'ai aussi dévelopé le résultat à l'aide
de formules, c'est relativement simple aussi.
http://www.cijoint.fr/cjlink.php?file=cj200906/cijkBynDod.xls

"ptck" a écrit dans le message de news:

bonsoir
je voulais savoir si on pouvait optimiser le code
merci


"garnote" a écrit dans le message de news:

Bonsoir,

Essaie ces formules et dis-moi si tu obtiens le résultat attendu.

Sur la feuille récap global :
1) Sélectionne B2:P21, entre cette formule
=SOMMEPROD((récap!$A$2:$A$215=$A2)*(récap!B2:B215))
et valide par Ctrl+Entrée.

2) Entre cette formule =SOMME(B2:P2) en Q2 et recopie jusqu'en Q21.

Serge


"ptck" a écrit dans le message de news:





bonsoir

Dans le fichier joint j'ai une macro qui fait le total par nom et
rubrique qui marche
mais elle est un peu longue. Débutant en macro, je pense qu'elle n'est
pas efficace
peut elle être améliorée?
Merci de votre aide
ptck


http://www.cijoint.fr/cjlink.php?file=cj200906/cijJ3Zrdf9.xls
















Avatar
garnote
Commence à être découragé !
Dernier essai. Après ça, je vous crisse la paix :-)

Sub Test()
Application.ScreenUpdating = False
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
F1.Columns(1).Clear
n = F2.Range("A1").SpecialCells(xlCellTypeLastCell).Row
F2.Range("B1:P1").Copy F1.Range("B1")
F1.Range("Q1") = "TOTAL"
F2.Range("a1:a" & n).Copy F1.Range("A1")
F2.Range("a1:a" & n).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:ñ.[a1], Unique:=True
n1 = F1.Range("A2").End(xlDown).Row
n2 = F2.Range("A2").End(xlDown).Row
Set r = F1.Range("B2:P" & n1)
r.Formula = "=SUMPRODUCT((récap!$A$2:$A$" & n2 & _
"=$A2)*récap!B$2:B$" & n2 & ")"
r.Value = r.Value
Set t = F1.Range("Q2:Q" & n1)
t.FormulaR1C1 = "=SUM(RC[-15]:RC[-2])"
t.Value = t.Value
Application.ScreenUpdating = True
End Sub

Bonsoir, Bonne nuit.
Serge




"garnote" a écrit dans le message de news:

Salut Fredo,

Celle-ci me semble correct aussi :
http://www.cijoint.fr/cjlink.php?file=cj200906/cijabbWmqo.xls

Serge



"Fredo P." a écrit dans le message de
news:
Il est parti plus vite que je l'aurrait voulu
La sub est rétrécie et optimisée, j'ai aussi dévelopé le résultat à
l'aide de formules, c'est relativement simple aussi.
http://www.cijoint.fr/cjlink.php?file=cj200906/cijkBynDod.xls

"ptck" a écrit dans le message de news:

bonsoir
je voulais savoir si on pouvait optimiser le code
merci


"garnote" a écrit dans le message de news:

Bonsoir,

Essaie ces formules et dis-moi si tu obtiens le résultat attendu.

Sur la feuille récap global :
1) Sélectionne B2:P21, entre cette formule
=SOMMEPROD((récap!$A$2:$A$215=$A2)*(récap!B2:B215))
et valide par Ctrl+Entrée.

2) Entre cette formule =SOMME(B2:P2) en Q2 et recopie jusqu'en Q21.

Serge


"ptck" a écrit dans le message de news:





bonsoir

Dans le fichier joint j'ai une macro qui fait le total par nom et
rubrique qui marche
mais elle est un peu longue. Débutant en macro, je pense qu'elle n'est
pas efficace
peut elle être améliorée?
Merci de votre aide
ptck


http://www.cijoint.fr/cjlink.php?file=cj200906/cijJ3Zrdf9.xls




















Avatar
MichDenis
Rapidement, il y a au moins ceci qui "cloche" !

Suppose que le résultat du filtre retourne moins d'enregistrements lors de l'exécution
suivante...
Est-ce possible que ce truc n'efface pas toutes les données déjà présentes dans la feuille
?
F1.Columns(1).Clear

n = F2.Range("A1").SpecialCells(xlCellTypeLastCell).Row
Le concept de "xlCellTypeLastCell" est plutôt faible... dans ce
cas ça ne change rien car on applique un filtre mais son usage
n'est pas terrible !!!!!!!!

Ça s'en vient ton truc !
;-)



"garnote" a écrit dans le message de groupe de discussion :

Commence à être découragé !
Dernier essai. Après ça, je vous crisse la paix :-)

Sub Test()
Application.ScreenUpdating = False
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
F1.Columns(1).Clear
n = F2.Range("A1").SpecialCells(xlCellTypeLastCell).Row
F2.Range("B1:P1").Copy F1.Range("B1")
F1.Range("Q1") = "TOTAL"
F2.Range("a1:a" & n).Copy F1.Range("A1")
F2.Range("a1:a" & n).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:ñ.[a1], Unique:=True
n1 = F1.Range("A2").End(xlDown).Row
n2 = F2.Range("A2").End(xlDown).Row
Set r = F1.Range("B2:P" & n1)
r.Formula = "=SUMPRODUCT((récap!$A$2:$A$" & n2 & _
"=$A2)*récap!B$2:B$" & n2 & ")"
r.Value = r.Value
Set t = F1.Range("Q2:Q" & n1)
t.FormulaR1C1 = "=SUM(RC[-15]:RC[-2])"
t.Value = t.Value
Application.ScreenUpdating = True
End Sub

Bonsoir, Bonne nuit.
Serge




"garnote" a écrit dans le message de news:

Salut Fredo,

Celle-ci me semble correct aussi :
http://www.cijoint.fr/cjlink.php?file=cj200906/cijabbWmqo.xls

Serge



"Fredo P." a écrit dans le message de
news:
Il est parti plus vite que je l'aurrait voulu
La sub est rétrécie et optimisée, j'ai aussi dévelopé le résultat à
l'aide de formules, c'est relativement simple aussi.
http://www.cijoint.fr/cjlink.php?file=cj200906/cijkBynDod.xls

"ptck" a écrit dans le message de news:

bonsoir
je voulais savoir si on pouvait optimiser le code
merci


"garnote" a écrit dans le message de news:

Bonsoir,

Essaie ces formules et dis-moi si tu obtiens le résultat attendu.

Sur la feuille récap global :
1) Sélectionne B2:P21, entre cette formule
=SOMMEPROD((récap!$A$2:$A$215=$A2)*(récap!B2:B215))
et valide par Ctrl+Entrée.

2) Entre cette formule =SOMME(B2:P2) en Q2 et recopie jusqu'en Q21.

Serge


"ptck" a écrit dans le message de news:





bonsoir

Dans le fichier joint j'ai une macro qui fait le total par nom et
rubrique qui marche
mais elle est un peu longue. Débutant en macro, je pense qu'elle n'est
pas efficace
peut elle être améliorée?
Merci de votre aide
ptck


http://www.cijoint.fr/cjlink.php?file=cj200906/cijJ3Zrdf9.xls




















Avatar
Charabeuh
Bonsoir,

Ta macro est OK après deux modifs dans mon propre classeur.

1) j'ai remplacé t.FormulaR1C1 = "=SUM(RC[-15]:RC[-2])"
par t.FormulaR1C1 = "=SUM(RC[-15]:RC[-1])"
(pour inclure la colonne W dans la somme)

2) j'ai remplacé n = F2.Range("A1").Resize(Cells(1, 1).Sp...
par n = F2.Range("A1").Resize(F2.Cells(1, 1).Sp...
( car si on lance la macro en étant sur la feuille F1,
Cells(1, 1) fait référence à F1 et non à F2.)

Attention au comportement de SpecialCells(xlCellTypeLastCell)
qui comme le nom l'indique est spécial et
qui peut garder en mémoire la dernière cellule utilisée même
si elle a été effacée.

exemple une feuille vierge "Feuil1" avec le code :

Sub test()
Range("A1") = 1
Range("A2") = 2
Range("A20").Value = 123456
Range("A20").ClearContents
n = Range("A1").Resize(Cells(1, 1). _
SpecialCells(xlCellTypeLastCell).Row, 1).Count
MsgBox n
End Sub

n renvoie 20 et non 2

3) Concernant les tests de vitesse, ta macro est équivalente
à celles utilisant sumproduct.

Bien le bonsoir,

Char Abeuh

"garnote" a écrit dans le message de
news:uoNp0%
Ave,

Ton n2 convient parfaitement.
Si le coeur t'en dit, pourrais-tu essayer cette macro :

Sub Test()
Application.ScreenUpdating = False
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
F1.Columns(1).Clear
n = F2.Range("A1").Resize(Cells(1,
1).SpecialCells(xlCellTypeLastCell).Row, 1).Count
F2.Range("a1:a" & n).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:ñ.[a1], Unique:=True
n1 = F1.Range("A2").End(xlDown).Row
n2 = F2.Range("A2").End(xlDown).Row
Set r = F1.Range("B2:P" & n1)
r.Formula = "=SUMPRODUCT((récap!$A$2:$A$" & n2 & "=$A2)*récap!B$2:B$" &
n2 & ")"
r.Value = r.Value
Set t = F1.Range("Q2:Q" & n1)
t.FormulaR1C1 = "=SUM(RC[-15]:RC[-2])"
t.Value = t.Value
Application.ScreenUpdating = True
End Sub

Serge






"Charabeuh" a écrit dans le message de news:

Ave à toi aussi,

si on fait,
r.Formula = "=SUMPRODUCT((récap!$A$2:$A$" & n2 & "=$A2)*récap!B$2:B$" &
n2 & ")"

c'est ti qu'ça marcherait ti point ? (je n'ai pas testé)

Pour l'approche:
Je ne vois pas comment cela s'adapte aux données sources (récap)
notamment aux changements de nombres de noms différents;

Mais j'avoue que je n'ai pas creusé 'plus que cela'.

== >>
En vitesse, les SUMPRODUCT sont plus pénalisants si on augmentent le
nombre d'enregistrement et le nombre de noms différents.

J'ai testé avec 10000 enregistrements et 5000 noms max différents. cela
donne environ :
Nbr Noms # 5000 Nbr Iter. # 1 Nbr Enrgt. # 10000
avec sumproduct ==> 208 s
sans sumproduct ==> 26 s

J'ai testé avec 10000 enregistrements et 500 noms max différents. cela
donne environ :
Nbr Noms # 500 Nbr Iter. # 1 Nbr Enrgt. # 10000
avec sumproduct ==> 22 s
sans sumproduct ==> 3 s

J'ai testé avec 10000 enregistrements et 20 noms max différents. cela
donne environ :
Nbr Noms # 20 Nbr Iter. # 1 Nbr Enrgt. # 10000
avec sumproduct ==> 1 s
sans sumproduct ==> 1 s


Bon! Je vais aller en ville un p'tit peu magasiner comme on dit "outre
atlantique.
(outre atlantique vu du côté Européen bien sûr !)
Char Abeuh





"garnote" a écrit dans le message de
news:
Ave,

Que pensez-vous de cette approche ?

Sub Test()
Application.ScreenUpdating = False
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
n1 = F1.Range("A2").End(xlDown).Row
n2 = F2.Range("A2").End(xlDown).Row
Set r = F1.Range("B2:P" & n1)
r.Formula = "=SUMPRODUCT((récap!$A$2:$A$500=$A2)*récap!B$2:B$500)"
r.Value = r.Value
Set t = F1.Range("Q2:Q" & n1)
t.FormulaR1C1 = "=SUM(RC[-15]:RC[-2])"
t.Value = t.Value
Application.ScreenUpdating = True
End Sub

ET

Comment faire pour remplacer le 500 de la ligne :
r.Formula = "=SUMPRODUCT((récap!$A$2:$A$500=$A2)*récap!B$2:B$500)"
par le n2 calculé sur cette ligne :
n2 = F2.Range("A2").End(xlDown).Row

Serge










1 2 3