Moyenne de tableaux en VBA

Version imprimable

Bonjour à tous !

Voila je débute vraiment en VBA et je viens vers vous car j'aimerai améliorer un programme et la je ne vois vraiment pas comment faire :

J'ai un tableau sur chaque feuille et j'aimerai recopier en page 7 la moyenne des tableaux des feuilles précédentes .

En gros j'aurais en D2 de ma feuille 7 la moyenne de tout les D2 des feuilles précédentes ... j'ai bidouillé le code suivant:
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 Sub moy_tab() Dim Sh As Worksheet reponse = InputBox(Prompt:=" recopier les valeurs moyennes sur quelle page ? ") Set Sh = Sheets(reponse) Range("D2").Select 'calcul de moy depend du nombre de machine étudiées : si on a 5 fiche il faudra prolonger la formule suivante avec 'Sheet5!RC etc 'Si le tableau est plus grand il faut redimensionner ActiveCell.FormulaR1C1 =AVERAGE(Sheet1!RC,Sheet2!RC,Sheet3!RC,Sheet4!RC) Range("D2").Select Selection.AutoFill Destination:=Range("D2:D864"), Type:=xlFillDefault Range("D2:D864").Select Range("D2:D864").Select Selection.AutoFill Destination:=Range("D2:CW864"), Type:=xlFillDefault End Sub
Sauf que voila si j'augmente considérablement le nombre de feuilles, il faut modifier le programme de façon assez fastidieuse ...

Je galère vraiment la, quelqu'un pour m'aider ?

Merci d'avance :)

09/06/2017, 09h42
joe.levrai

Bonjour,

utilises la structure d'un calcul 3D : =MaFONCTION(PremiereFeuille:DerniereFeuille!Position)

toutes les feuilles qui sont placées (dans la barre d'onglet des feuilles) entre ces deux feuilles seront incluses dans le calcul

Dès lors, tu veilles simplement à toujours avoir la feuille de départ et d'arrivée qui ne change ni de position, ni de nom, et toute feuille qui tu vas intercaler entre elles seront automatiquement intégrées au calcul de ta moyenne

Code:

ActiveCell.FormulaR1C1 = "=AVERAGE(Feuil1:Feuil4!RC)"

Merci beaucoup pour ton aide !
j'ai essayé de modifier un petit peu le code mais excel ne semble pas encore apprécier ...

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
 
Function MaFONCTION(PremiereFeuille, DerniereFeuille)
 
Dim Sh As Worksheet
 
    reponse = InputBox(Prompt:=" recopier les valeurs moyennes sur quelle page ? ")
    Set Sh = Sheets(reponse)
 
    Range("D2").Select
    'calcul de moy depend du nombre de machine étudiées : si on a 5 fiche il faudra prolonger la formule suivante avec
    'Sheet5!RC etc
 
    'Si le tableau est plus grand il faut redimensionner
 
    ActiveCell.FormulaR1C1 =AVERAGE(PremiereFeuille:DerniereFeuille!RC)
 
    Range("D2").Select
 
    Selection.AutoFill Destination:=Range("D2:D864"), Type:=xlFillDefault
 
    Range("D2:D864").Select
 
    Range("D2:D864").Select
 
    Selection.AutoFill Destination:=Range("D2:CU864"), Type:=xlFillDefault
 
End Function

Je ne vois pas pourquoi ... un dernier coup de main ?

09/06/2017, 10h23
joe.levrai
Pourquoi avoir changé la façon de faire ? Ta syntaxe n'était pas bonne.

En gros, tu remplaçais ta ligne par la mienne ET tu changeais le nom des feuilles, j'avais mis des noms bidons pour bien comprendre

En reprenant tes noms de feuilles (De Sheet1 à Sheet4 si c'est bien leur nom) :

Code:

ActiveCell.FormulaR1C1 = "=AVERAGE(Sheet1:Sheet4!RC)"

Et vu que derrière tu fais un autofill pour recopier ta formule, autant tout faire d'un coup !

Code:

Range("D2:CU864").FormulaR1C1 = "=AVERAGE(Sheet1:Sheet4!RC)"

EDIT : et si tu n'as pas besoin de conserver les formules, on peut les remplacer ensuite par leur résultat, ce qui donne :
Code:

1 2 3 4 With Range("D2:CU864") .FormulaR1C1 = "=AVERAGE(Sheet1:Sheet4!RC)" .Value = .Value End With

Pardon excuse moi c'est vrai que je fais un peu n'importe quoi la ...
je ne me suis pas bien exprimé : en gros j'aimerai pouvoir demander à l'utilisateur la première et la dernière page

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub moy_tab()
 
Dim Sh As Worksheet
Dim pr As Worksheet
Dim der As Worksheet
 
 
    reponse = InputBox(Prompt:=" recopier les valeurs moyennes sur quelle page ? ")
    Set Sh = Sheets(reponse)
    p = InputBox(Prompt:=" premiere page ? ")
    d = InputBox(Prompt:=" derniere page ? ")
 
 
    'Si le tableau est plus grand il faut redimensionner
Set pr = Sheets(p)
Set der = Sheets(d)
 
With Range("D2:CU864")
    .FormulaR1C1 = "=AVERAGE(pr:der!RC)"
    .Value = .Value
End With
 
End Sub

Bonjour,
Code:

1 2 3 4 5 6 p = InputBox(Prompt:=" premiere page ? ") d = InputBox(Prompt:=" derniere page ? ") With Range("D2:CU864") .FormulaR1C1 = "=AVERAGE(" & p & ":" & d & "!RC)" .Value = .Value End With
Mais bonjour les erreurs dues aux saisies dans les InputBox!...

EDIT : A lire pour éviter les erreurs

09/06/2017, 11h17
supengalere

c'est vrai que la InputBox je maitrise pas encore super bien :oops:
En tout cas , merci infiniment à tout les deux pour votre aide précieuse : Ca fonctionne du tonnerre ! :mrgreen:
Très bonne journée à tous !

Regarde ce test, et modifie ta Sub en conséquence

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub essai()
Dim reponse As String, Sh As Worksheet
Do
    reponse = InputBox(Prompt:=" recopier les valeurs moyennes sur quelle page ? ")
Loop While FeuilleExiste(ThisWorkbook, reponse) = False
Set Sh = Sheets(reponse)
MsgBox Sh.Name
End Sub
 
Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
 On Error Resume Next
 FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function