Bonjour,
l'enregistreur de macro ne t'a pas doublé les "" finales ? Etonnant.
eric
Bonjour,
l'enregistreur de macro ne t'a pas doublé les "" finales ? Etonnant.
eric
Suis-je bete...... lol
thanks ca marche
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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 appettit
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
Un tableau non régulier est souvent source de complications inutiles.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'erreur
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
sur For Each C In Cells.pl3
tu aurais une idée ?
Voici le code global
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 !!! ;-)
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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 : Sélectionner tout - Visualiser dans une fenêtre à part if Application.WorksheetFunction.Match dans pl1.....
ewt-ce que je dois passer par les valeurs relatives/absolues ?
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
ewt-ce que je dois passer par les valeurs relatives/absolues ?
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
Bonjour,
Si tout à fait.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part 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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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 à toieriic.xlsm
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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 : Sélectionner tout - Visualiser dans une fenêtre à part 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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
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
Bonne journée
Seb
###############################
C'est Totomatique, On va tout Totomate-isé ;-)
###############################
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager