optimiser une macro

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
garnote
Le #19553701
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"




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



ptck
Le #19553691
bonsoir
je voulais savoir si on pouvait optimiser le code
merci


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




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








MichDenis
Le #19553911
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"




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
garnote
Le #19554131
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"
bonsoir
je voulais savoir si on pouvait optimiser le code
merci


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




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












Charabeuh
Le #19554221
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" 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



garnote
Le #19554361
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" %
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" 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






ptck
Le #19556081
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"
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" %
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" 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











ptck
Le #19556471
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" 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"
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" %
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" 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
















MichDenis
Le #19556461
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" 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"
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" %
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" 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











MichDenis
Le #19556451
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"
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" 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"
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" %
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" 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











Publicité
Poster une réponse
Anonyme