Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

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

10 réponses

1 2 3
Avatar
garnote
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
ptck
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
Bonjour Ptck,

Essaie ceci :

N.B- attention aux coupures de lignes à des endroits inopportuns par le service de
messagerie.

'-----------------------------------------
Sub récap_global()
Dim Rg As Range, Rg1 As Range, M As String

Application.ScreenUpdating = False
With Sheets("récap global")
With .Range("a1").CurrentRegion
.Offset(1).Clear
Set Rg = .Cells
End With
End With

With Sheets("récap")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("récap global").Range("a1"), _
Unique:=True
Set Rg1 = .CurrentRegion.Offset(1).Resize(.Rows.Count - 1)
End With
End With

Set Rg = Rg.Offset(1).Resize(Rg.CurrentRegion.Rows.Count - 1, _
Rg.Columns.Count - 1)

M = "=sumproduct((" & Rg1(1).Parent.Name & "!" & _
Rg1.Columns(Range("A1").Column).Address(1, 1) & _
"=" & Rg1(1).Parent.Name & _
"!" & Rg(1).Address(0, 1) & ")*(" & Rg1(1).Parent.Name & _
"!" & Rg1.Columns(Range("B1").Column).Address(1, 0) & "))"

With Rg.Offset(, 1).Resize(, Rg.Columns.Count - 1)
.Formula = M
.Value = .Value
End With

With Rg(, Rg(, Rg.Columns.Count + 1).Column).Resize(Rg.Rows.Count)
.Formula = _
"=sum(" & Rg1.Offset(-1, 1).Resize(, Rg1.Columns.Count - 2) _
.Rows(Range("A2").Row).Address(0, 0) & ")"
.Value = .Value
End With
Application.ScreenUpdating = True

End Sub
'-----------------------------------------




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





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
Ave,

Oublie ça. Ma formule ne donne même pas le bon résultat.
J'ai simplifié ta macro mais la rapidité de la macro de Denis
est tellement foudroyante que je ne publie pas mon timide essai :-)

Serge


"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
Bonjour,

Une autre piste:

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse

Sheets("récap global").Range("A1").CurrentRegion.ClearContents

SourceAdresse = Sheets("récap").Name & "!" & _
Sheets("récap").Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)

Sheets("récap global").Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse

LastCol = Sheets("récap global").Range("A1"). _
CurrentRegion.Columns.Count
LastRow = Sheets("récap global").Range("A1"). _
CurrentRegion.Rows.Count

Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

Sheets("récap global").Cells(1, LastCol).Value = "Total"

Application.CutCopyMode = False
End Sub






"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
Et si tu me permets :

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
With F1
.Activate
.Range("A1").CurrentRegion.ClearContents
SourceAdresse = F2.Name & "!" & _
F2.Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)
.Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse
LastCol = .Range("A1"). _
CurrentRegion.Columns.Count
LastRow = .Range("A1"). _
CurrentRegion.Rows.Count
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues
.Cells(1, LastCol).Value = "Total"
End With
Application.CutCopyMode = False
End Sub

Serge



"Charabeuh" a écrit dans le message de news:
%
Bonjour,

Une autre piste:

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse

Sheets("récap global").Range("A1").CurrentRegion.ClearContents

SourceAdresse = Sheets("récap").Name & "!" & _
Sheets("récap").Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)

Sheets("récap global").Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse

LastCol = Sheets("récap global").Range("A1"). _
CurrentRegion.Columns.Count
LastRow = Sheets("récap global").Range("A1"). _
CurrentRegion.Rows.Count

Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

Sheets("récap global").Cells(1, LastCol).Value = "Total"

Application.CutCopyMode = False
End Sub






"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
ptck
Merci encore
mais la macro de MichDenis me fait des totaux erronés sur certain nom
dans l'exemple que j'ai envoyé çà marche mais avec mon tableau initial
certain noms sont erronés
je cherche!!

ptck

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

Et si tu me permets :

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
With F1
.Activate
.Range("A1").CurrentRegion.ClearContents
SourceAdresse = F2.Name & "!" & _
F2.Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)
.Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse
LastCol = .Range("A1"). _
CurrentRegion.Columns.Count
LastRow = .Range("A1"). _
CurrentRegion.Rows.Count
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues
.Cells(1, LastCol).Value = "Total"
End With
Application.CutCopyMode = False
End Sub

Serge



"Charabeuh" a écrit dans le message de news:
%
Bonjour,

Une autre piste:

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse

Sheets("récap global").Range("A1").CurrentRegion.ClearContents

SourceAdresse = Sheets("récap").Name & "!" & _
Sheets("récap").Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)

Sheets("récap global").Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse

LastCol = Sheets("récap global").Range("A1"). _
CurrentRegion.Columns.Count
LastRow = Sheets("récap global").Range("A1"). _
CurrentRegion.Rows.Count

Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

Sheets("récap global").Cells(1, LastCol).Value = "Total"

Application.CutCopyMode = False
End Sub






"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
ptck
rebonjour

j'ai tout essayé toute marche
sauf celle de MichDenis (désolé) :)
j'ai plus qu'à m'inspirer de vos codes
merci encore à vous trois
ptck



"ptck" a écrit dans le message de news:
u5QdX$
Merci encore
mais la macro de MichDenis me fait des totaux erronés sur certain nom
dans l'exemple que j'ai envoyé çà marche mais avec mon tableau initial
certain noms sont erronés
je cherche!!

ptck

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

Et si tu me permets :

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
With F1
.Activate
.Range("A1").CurrentRegion.ClearContents
SourceAdresse = F2.Name & "!" & _
F2.Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)
.Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse
LastCol = .Range("A1"). _
CurrentRegion.Columns.Count
LastRow = .Range("A1"). _
CurrentRegion.Rows.Count
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues
.Cells(1, LastCol).Value = "Total"
End With
Application.CutCopyMode = False
End Sub

Serge



"Charabeuh" a écrit dans le message de news:
%
Bonjour,

Une autre piste:

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse

Sheets("récap global").Range("A1").CurrentRegion.ClearContents

SourceAdresse = Sheets("récap").Name & "!" & _
Sheets("récap").Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)

Sheets("récap global").Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse

LastCol = Sheets("récap global").Range("A1"). _
CurrentRegion.Columns.Count
LastRow = Sheets("récap global").Range("A1"). _
CurrentRegion.Rows.Count

Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

Sheets("récap global").Cells(1, LastCol).Value = "Total"

Application.CutCopyMode = False
End Sub






"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
Si cela peut t'aider, tu peux inhiber les deux lignes de code de ce type dans la procédure
:
.Value = .Value
en plaçant une apostrophe en début de la ligne.
Le tableau des données contiendra toutes les formules
avant de les faires disparaître pour n'afficher le résultat.



"ptck" a écrit dans le message de groupe de discussion :
u5QdX$
Merci encore
mais la macro de MichDenis me fait des totaux erronés sur certain nom
dans l'exemple que j'ai envoyé çà marche mais avec mon tableau initial
certain noms sont erronés
je cherche!!

ptck

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

Et si tu me permets :

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
With F1
.Activate
.Range("A1").CurrentRegion.ClearContents
SourceAdresse = F2.Name & "!" & _
F2.Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)
.Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse
LastCol = .Range("A1"). _
CurrentRegion.Columns.Count
LastRow = .Range("A1"). _
CurrentRegion.Rows.Count
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues
.Cells(1, LastCol).Value = "Total"
End With
Application.CutCopyMode = False
End Sub

Serge



"Charabeuh" a écrit dans le message de news:
%
Bonjour,

Une autre piste:

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse

Sheets("récap global").Range("A1").CurrentRegion.ClearContents

SourceAdresse = Sheets("récap").Name & "!" & _
Sheets("récap").Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)

Sheets("récap global").Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse

LastCol = Sheets("récap global").Range("A1"). _
CurrentRegion.Columns.Count
LastRow = Sheets("récap global").Range("A1"). _
CurrentRegion.Rows.Count

Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

Sheets("récap global").Cells(1, LastCol).Value = "Total"

Application.CutCopyMode = False
End Sub






"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
Je viens de vérifier un à un les 21 totaux du fichier original que tu as publié avec les
21 totaux résultant de la procédure, et ces derniers sont les mêmes !

http://cjoint.com/?gnmRsL2tIu



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

Si cela peut t'aider, tu peux inhiber les deux lignes de code de ce type dans la procédure
:
.Value = .Value
en plaçant une apostrophe en début de la ligne.
Le tableau des données contiendra toutes les formules
avant de les faires disparaître pour n'afficher le résultat.



"ptck" a écrit dans le message de groupe de discussion :
u5QdX$
Merci encore
mais la macro de MichDenis me fait des totaux erronés sur certain nom
dans l'exemple que j'ai envoyé çà marche mais avec mon tableau initial
certain noms sont erronés
je cherche!!

ptck

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

Et si tu me permets :

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("récap global")
Set F2 = Sheets("récap")
With F1
.Activate
.Range("A1").CurrentRegion.ClearContents
SourceAdresse = F2.Name & "!" & _
F2.Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)
.Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse
LastCol = .Range("A1"). _
CurrentRegion.Columns.Count
LastRow = .Range("A1"). _
CurrentRegion.Rows.Count
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
.Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues
.Cells(1, LastCol).Value = "Total"
End With
Application.CutCopyMode = False
End Sub

Serge



"Charabeuh" a écrit dans le message de news:
%
Bonjour,

Une autre piste:

Sub Recap2()
Dim LastCol, LastRow, SourceAdresse

Sheets("récap global").Range("A1").CurrentRegion.ClearContents

SourceAdresse = Sheets("récap").Name & "!" & _
Sheets("récap").Range("A1").CurrentRegion. _
Address(ReferenceStyle:=xlR1C1)

Sheets("récap global").Range("A1").Consolidate Sources:= _
SourceAdresse, Function:=xlSum, _
TopRow:=True, LeftColumn:=True, CreateLinks:úlse

LastCol = Sheets("récap global").Range("A1"). _
CurrentRegion.Columns.Count
LastRow = Sheets("récap global").Range("A1"). _
CurrentRegion.Rows.Count

Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).FormulaR1C1 = _
"=SUM(RC[-" & (LastCol - 1) & "]:RC[-1])"
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).Copy
Sheets("récap global").Range(Cells(2, LastCol), _
Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

Sheets("récap global").Cells(1, LastCol).Value = "Total"

Application.CutCopyMode = False
End Sub






"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











1 2 3