Bonjour,
l'enregistreur de macro ne t'a pas doublé les "" finales ? Etonnant.
eric
Version imprimable
Bonjour,
l'enregistreur de macro ne t'a pas doublé les "" finales ? Etonnant.
eric
Suis-je bete...... lol
thanks ca marche
du coup je surfe sur ton idée pour incrémenter d'autres formules dans mon tableau
je rajoute une variable pl3 qui correspondt à la colonne D
et je cherche à poser la formule "=IFERROR(R[-2]C-R[-1]C,"""")" que sur les lignes de la colonne D comportant le mot "Ecart"
je me dis qu'en recopiant ton schéma cela devrait marcher....
il faut fouiller each cells in pl3 ?????
Bon appettitCode:
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 Dim pl1 As Range, Dim pl3 As Range,t As Single Sub SyntheseDonnéesAvecTempo() Dim pl2 As Range, col As Long Dim LastAnnee As Long Sheets("SYNTHESE").Activate t = Timer LastAnnee = (Range("A3").Value - 2015) * 16 + 6 On Error GoTo fin Set pl1 = [A15:A650].SpecialCells(xlCellTypeConstants).EntireRow ' lignes On Error GoTo 0 Set pl2 = Columns(6).Resize(, 12) For col = 6 To LastAnnee Step 16 Set pl2 = Union(pl2, Columns(col).Resize(, 12)) ' colonnes Next col Set pl1 = Intersect(pl1, pl2) pl1.FormulaR1C1 = "=if((R1C<=Mois_Reporting),SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT)),"""")" ' pl1.FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))" 'Set pl3 = [d15:d650].SpecialCells(xlCellTypeConstants).EntireColumn '---> Comment selectionner les lignes de pl3 ="Ecart" ?????? 'Set pl3 = Intersect(pl2,pl3) 'pl3.FormulaR1C1 = "=IFERROR(R[-2]C-R[-1]C,"""")" DoEvents Application.OnTime Now + TimeValue("00:00:5"), "resultat" fin: End Sub Sub resultat() 'pl1.Value = pl1.Value Désactivation_App pl1.Select For Each cel In Selection cel.Copy Range(cel.Address).Select cel.PasteSpecial Paste:=xlPasteValues Next cel ' pl3.Select ' For Each cel In Selection 'cel.Copy ' Range(cel.Address).Select ' cel.PasteSpecial Paste:=xlPasteValues Next cel Activation_App MsgBox "Opération terminée pour une durée de " & Timer - t End Sub
ps chez moi Désactivation_App et Activation_App sont (bien pratiques)
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 Sub Désactivation_App() 'On désactive les applications (optimisation). With Application .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual End With End Sub Sub Activation_App() 'On réactive les applications (ne pas oublier). With Application .EnableEvents = True .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub
Un tableau non régulier est souvent source de complications inutiles.Citation:
et je cherche à poser la formule "=IFERROR(R[-2]C-R[-1]C,"""")" que sur les lignes de la colonne D comportant le mot "Ecart"
Tu ne peux pas trouver une formule unique valable pour toutes les lignes ?
Ou bien utiliser une colonne supplémentaire, tu as de la marge avec 16384...
Sinon quoi te dire d'autre que si tu appliques le même principe correctement tu devrais avoir un résultat correct...
eric
je suis obligé de respecter des formules différentes.
C'est un trableau trés complexe
ne fonctionne pas , grrrrr, j'ai un message d'erreurCode:
1
2
3
4
5
6 For Each C In Cells.pl3 If C.Value = "Ecart" Then Set pl3 = Intersect(pl2, pl3) pl3.FormulaR1C1 = "=IFERROR(R[-2]C-R[-1]C,"""")" End If Next C
Pièce jointe 304094
sur For Each C In Cells.pl3
tu aurais une idée ?
Voici le code global
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 Dim pl1 As Range Dim pl3 As Range, t As Single Sub SyntheseDonnéesAvecTempo() Dim pl2 As Range, col As Long Dim LastAnnee As Long Sheets("SYNTHESE").Activate t = Timer LastAnnee = (Range("C2").Value - 2015) * 16 + 6 ' LastAnnee = Application.InputBox("Quelle Année ?", Type:=1) On Error GoTo fin Set pl1 = [A15:A650].SpecialCells(xlCellTypeConstants).EntireRow ' lignes On Error GoTo 0 Set pl2 = Columns(6).Resize(, 12) For col = 6 To LastAnnee Step 16 Set pl2 = Union(pl2, Columns(col).Resize(, 12)) ' colonnes Next col Set pl1 = Intersect(pl1, pl2) pl1.FormulaR1C1 = "=if((R1C<=Mois_Reporting),SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT)),0)" ' pl1.FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))" 'Set pl3 = [d15:d650].SpecialCells(xlCellTypeConstants).EntireColumn '---> Comment selectionner les lignes de pl3 ="Ecart" ?????? 'Set pl3 = Intersect(pl2,pl3) 'pl3.FormulaR1C1 = "=IFERROR(R[-2]C-R[-1]C,"""")" For Each C In Cells.pl3 If C.Value = "Ecart" Then Set pl3 = Intersect(pl2, pl3) pl3.FormulaR1C1 = "=IFERROR(R[-2]C-R[-1]C,"""")" End If Next C DoEvents Application.OnTime Now + TimeValue("00:00:5"), "resultat" fin: End Sub Sub resultat() 'pl1.Value = pl1.Value Désactivation_App pl1.Select For Each cel In Selection cel.Copy Range(cel.Address).Select cel.PasteSpecial Paste:=xlPasteValues Next cel ' pl3.Select ' For Each cel In Selection 'cel.Copy ' Range(cel.Address).Select ' cel.PasteSpecial Paste:=xlPasteValues 'Next cel Activation_App MsgBox "Opération terminée pour une durée de " & Timer - t End Sub
Ouais mais bon, en dehors du fait que tu n'indiques même pas la ligne en erreur il faut essayer de comprendre avant de reproduire.
Set pl3 = [d15:d650].SpecialCells(xlCellTypeConstants).EntireColumn n'a aucun sens.
Apprend déjà à déboguer et utiliser les espions ça évitera des incongruités, ça ne sera pas du temps perdu.
mériterai un commentaire sur presque chaque ligne mais je n'ai pas le courage. Et sorti du contexte on ne sait pas ce qu'est chaque objet... En tout cas ça n'a plus grand chose à voir avec la logique que j'ai utilisée.Code:
1
2
3
4
5
6 For Each C In Cells.pl3 If C.Value = "Ecart" Then Set pl3 = Intersect(pl2, pl3) pl3.FormulaR1C1 = "=IFERROR(R[-2]C-R[-1]C,"""")" End If Next C
hello
hello
merci des recommandations.
je vais y travailler ce we !!! ;-)
Hello
tu avais raison
J'ai revu mon mode de résonnement et je me suis basé sur le tien !!!
Thanks
Du coup j'ai inserer la colonne C pour y mettre un critére qui me permet de déclencher pl3
Je ne sais pas si c'est le plus optimisé mais cela fonctionne.
Dans l'absolut ? ne serait-ce pas plus simple de flitrer .SpecialCells(xlCellTypeConstants).EntireRow
Si .SpecialCells(xlCellTypeConstants).EntireRow= "BABA" alors .......
Pour voir je test avec
c'est cohérent selon toi ?Code:if Application.WorksheetFunction.Match dans pl1.....
ewt-ce que je dois passer par les valeurs relatives/absolues ?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 Dim pl1 As Range Dim pl3 As Range, t As Single Sub SyntheseDonnéesAvecTempo() Dim pl2 As Range, col As Long Dim LastAnnee As Long Sheets("SYNTHESE").Activate t = Timer LastAnnee = (Range("d2").Value - 2015) * 16 + 7 ' LastAnnee = Application.InputBox("Quelle Année ?", Type:=1) On Error GoTo fin Set pl1 = [A15:A650].SpecialCells(xlCellTypeConstants).EntireRow ' lignes Set pl3 = [C15:C650].SpecialCells(xlCellTypeConstants).EntireRow ' lignes On Error GoTo 0 Set pl2 = Columns(7).Resize(, 12) For col = 7 To LastAnnee Step 16 Set pl2 = Union(pl2, Columns(col).Resize(, 12)) ' colonnes Next col Set pl1 = Intersect(pl1, pl2) pl1.FormulaR1C1 = "=if((R1C<=Mois_Reporting),SUMPRODUCT((Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC5)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT)),"""")" Set pl3 = Intersect(pl3, pl2) pl3.FormulaR1C1 = "=IFERROR(R[-2]C-R[-1]C,"""")" DoEvents Application.OnTime Now + TimeValue("00:00:5"), "resultat" fin: End Sub Sub resultat() Désactivation_App pl1.Select For Each cel In Selection cel.Copy Range(cel.Address).Select cel.PasteSpecial Paste:=xlPasteValues Next cel Activation_App MsgBox "Opération terminée pour une durée de " & Timer - t End Sub
ewt-ce que je dois passer par les valeurs relatives/absolues ?
Bonjour,
Si tout à fait.Code:
1
2 Dans l'absolut ? ne serait-ce pas plus simple de flitrer .SpecialCells(xlCellTypeConstants).EntireRow Si .SpecialCells(xlCellTypeConstants).EntireRow= "BABA" alors
Je te propose de faire une suggestion à microsoft qu'ils l'ajoutent à la prochaine version ;-)
Ca a l'air, en tout cas rien qui ne m'ait fait bondir de ma chaise comme l'autre fois. J'ai encore la bosse de la rencontre avec le plafond ;-)Code:c'est cohérent selon toi ?
Je n'ai pas relu les 3 pages mais j'ai l'impression que tu as baissé considérablement la tempo.
Plus autant de problème de synchro pour les résultats ? Garde une bonne marge, comme je te l'avais dit mélanger calcul sur feuille et macro est source d'erreurs...
En ayant repris à froid je me dis qu'on (moi en tout cas) ne s'est pas assez penchés sur la formule tu devrais tout calculer dans la macro.
A moment donné je t'avais demandé un fichier de travail de qq lignes que tu n'as jamais fourni. C'est sans doute dommage
eric
hello
Bon si je fais de suggestions à microsoft je vais me faire embaucher chez eux lol
nan plus de soucis de synchro des résultats ;-)
C'est parfait :-)
Pour la formule effectivement on peut travailler.
Je reconnais avoir zappé de t'envoyer un fichier anonymisé.
c'est un peu chaud-cahouétes, c'est mon fichier de comptes perso....
je peux creer qqc
je vois dans l'am
bon c'était plus simple que je pensais
j'ai fait uneversion légére de ma BDD et de la feuille de calcul
thanks à toiPièce jointe 304848
Mouais, c'est bien ce que je pressentais...
Mes réflexes étaient émoussés, j'aurais dû plus insister.
Tu n'as jamais entendu parlé des TCD (tableaux croisés dynamiques) ?
*pressentais, pas présentais
Bonjour,
Mais qu'est-ce qui t'empêche de faire un TCD te présentant tous les résultats dont tu as besoin plutôt que t'arrêter au milieu du chemin et mettre une pelletée de sommeprod derrière ?
Tu auras les résultats en 1s au lieu des 45' du début...
Libre à toi ensuite de les récupérer pour les mettre où tu veux et comme tu veux de la même façon.
En plus tu as tes chances que vba ne reprenne la main qu'à la fin du refresh du TCD (? à vérifier)
Au-delà de ça quel est l'intérêt de recalculer 2015 en 2017 ? Tu continueras encore en 2025 ?
La validité d'un chèque étant de 12 mois aucun intérêt à remonter au-delà, ça ne bougera plus.
Pour ma part je vais m'arrêter là le principe restant le même.
eric
Hello
Lire un tcd pr ensuite remplir mon tableau..... Purée je n'y avais pas pensé......
Génial ton idée.
Je vais explorer la solution.
Merci à toi de ton aide.
Ton aide à été précieuse
À+
Seb
re hello
effectivement tu avai raison
j'ai créer un tcd et plouplouf la formule (a améliorer)
Les résultats apparaissent en 8 sec. hallucinant !!!Code:pl1.FormulaR1C1 = "=IFERROR(IF(R1C<=Mois_Reporting,GETPIVOTDATA(""DEBITCREDIT"",TCD!R5C1,""BUDGET REEL"",RC5,""POSTE"",RC2,""ANNEE"",YEAR(R7C),""MOIS"",R2C,""COMPTE"",RC1,""BQ"",""OUI""),GETPIVOTDATA(""DEBITCREDIT"",TCD!R5C1,""BUDGET REEL"",RC5,""POSTE"",RC2,""ANNEE"",YEAR(R7C),""MOIS"",R2C,""COMPTE"",RC1,""BQ"",""NON"")),""0"")"
Bravo et encore merci à toi
Bonjour,
Essaie sans vba, met tes formules directement sur la feuille.
Seules celles devant être ré-évaluées le seront. En plus tu bénéficieras de tes 4 ou 8 coeurs si il peut au lieu d'un seul.
Hello
Ça Marche nikel !
thanks