Faire des moyennes sur un tableau qui varie...? [Résolu]

cs_pafacile 30 Messages postés vendredi 27 juin 2008Date d'inscription 22 juillet 2008 Dernière intervention - 7 juil. 2008 à 22:42 - Dernière réponse : bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention
- 9 juil. 2008 à 00:15
Salut à tous,

J'en ai une autre pour vous ...

Voilà, J'ai un tableau comme suit

Sem1    Sem2     Sem3     Sem4      Sem5      Sem6     ....etc...
   2           3             4            5            3            2

Ce tableau est de taille variable (en longueur)
Je voudrais donc récupérer sa taille et faire une moyenne des resultats de la deuxième ligne mais toutes les 3 cellules. Autrement dit: Je voudrais que par exemple sur la ligne d'apres cela me sortent la mayenne des résultats des semaines 1, 2 et 3   puis la moyenne des semaines 4, 5 et 6 etc...


Bien sur, comme la longuer du tableau est variable, sa taille peut etre paire ou impaire... la dernière moyenne serait donc faite sur 3 semaines ou 2 semaines...
Disons que mon tbleau s'appelle MonTableau


Je sais que je dois utiliser UBound pour connaitre sa taille, diviser... et deux boucles mais j'ai du mal...et un if et....

Si vous pouvez me filer un coup de main...

Merci à tous

Pafacile
Afficher la suite 

25 réponses

Répondre au sujet
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 8 juil. 2008 à 06:18
+3
Utile
Salut,

PCPT et LIBRE_MAX : pas de chance elle est en VBA

pafacile fait gaffe au theme sinon PCPT vas ce facher ... il est pas facile non plus... olala non... pffff ...

non serieusement le bon theme pour le VBA c'est ici :

 Thèmes / Visual Basic 6 / Langages dérivés / VBA /

Je te propose d'utiliser la fonction average d'Excel qui a l'avantage de ne pas tenir compte des cellules vides... si si ... cela fait toujours ca de gagne
Dans le bout de code qui suit j'ai considere que les donnes sont en ligne 2, la premiere en A2 exactement.
J'ai aussi fait le choix de poser le resultat tout les "pas" sur la ligne 3

Sub bob() 'mais! qui c'est ce bob ?
    Dim ColDerniereValeur As Long, i As Long, Pas As Long, LigneResultat As Long
    LigneResultat = 3
    Pas = 3
    i = 0
   
    With Sheets("sheet1") 'attention a partir d'ici tout les points sont OBLIGATOIR
        ' on efface la ligne de resultat au cas ou le nombre de valeur ou le pas aurait change
        .Rows(LigneResultat).ClearContents
       
        'recherche de la derniere colonne contenant une valeur
        ColDerniereValeur = .Rows(2).Find("*", , , , , xlByColumns, xlNext).Column
       
        ' une limitation au cas ou le pas serait plus grand que le nombre de valeur
        If Pas > ColDerniereValeur Then Pas = ColDerniereValeur
       
        ' on boucle tant que l'on est pas arrive a la derniere colonne(valeur)
        Do Until i >= ColDerniereValeur 'le signe > ne sert qu'a eviter de ce retrouver coince dans la boucle on ne sait jamais
            i = i + Pas
            ' calcul de la moyenne a l' aide de la fonction average d'excel
            'en VBA l'utilisation des fonctions via la propriete WorksheetFunction ce fait avec les fonctions anglaises
            ' les valeurs sont en ligne 2
            ' on pose le resultat toute les "Pas" colonnes en ligne LigneResultat... ok c'est pas tres francais mais j'aime bien ^^
            .Cells(LigneResultat, i).Value = Application.WorksheetFunction.Average(.Range(.Cells(2, i - (Pas - 1)), .Cells(2, i)))
            ' si le resultat de la soustraction est inferieur au pas
            ' c'est que le nonbre de valeurs(colonnes) n'est pas un multiple du pas
            ' mais il doit aussi etre plus grand que 1 car une moyenne sur une seul valeur cela n'a pas de sens
            If ColDerniereValeur - i < Pas And ColDerniereValeur - i > 1 Then                Pas ColDerniereValeur - i ' le pas nombre de valeurs restante
            ElseIf ColDerniereValeur - i = 1 Then
                Exit Do ' si il ne reste plus qu'une valeur on arrete tout
            End If
        Loop
    End With
End Sub

Coloration syntaxique a la mano par bigfish

A+

3ddI7IHd
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de bigfish_le vrai
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 8 juil. 2008 à 18:35
+3
Utile
Ok je vois pas de probleme sur ce que tu as rajoutée si ce n'est que tu n'as pas tenu compte de mon precedent message.

Par contre vu que tu vas utiliser les moyennes pour un graphe je te propose de les regrouper directement pour ne pas avoir a gerer les cellules vide cela simplifira ton code.

Sub moyenne()
    Dim ColDerniereValeur As Long, i As Long, Pas As Long, LigneResultat As Long
    Dim ColResultat As Long
    LigneResultat = 3
    ColResultat = 1
    Pas = 3
    i = 2
   
    With Sheets("feuil3") 'attention a partir d'ici tout les points sont OBLIGATOIR
        ' on efface la ligne de resultat au cas ou le nombre de valeur ou le pas aurait change
        .Rows(LigneResultat).ClearContents
      
        'recherche de la derniere colonne contenant une valeur
        ColDerniereValeur = .Rows(38).Find("*", , , , , xlByColumns, xlNext).Column
      
        ' une limitation au cas ou le pas serait plus grand que le nombre de valeur
        If Pas > ColDerniereValeur Then Pas = ColDerniereValeur
      
        ' on boucle tant que l'on est pas arrive a la derniere colonne(valeur)
        Do Until i >= ColDerniereValeur 'le signe > ne sert qu'a eviter de ce retrouver coince dans la boucle on ne sait jamais
            i = i + Pas
            ' calcul de la moyenne a l' aide de la fonction average d'excel
            'en VBA l'utilisation des fonctions via la propriete WorksheetFunction ce fait avec les fonctions anglaises
            ' les valeurs sont en ligne 2
            ' on pose le resultat toute les "Pas" colonnes en ligne LigneResultat... ok c'est pas tres francais mais j'aime bien ^^
            On Error Resume Next <--- attention ici j'ai enlever : local
            .Cells(LigneResultat, ColResultat).Value = Application.WorksheetFunction.Average(.Range(.Cells(38, i - (Pas - 1)), .Cells(38, i)))
            ' si le resultat de la soustraction est inferieur au pas
            ' c'est que le nonbre de valeurs(colonnes) n'est pas un multiple du pas
            ' mais il doit aussi etre plus grand que 1 car une moyenne sur une seul valeur cela n'a pas de sens
            If ColDerniereValeur - i < Pas And ColDerniereValeur - i > 1 Then                Pas ColDerniereValeur - i ' le pas nombre de valeurs restante
            ElseIf ColDerniereValeur - i = 1 Then
                Exit Do ' si il ne reste plus qu'une valeur on arrete tout
            End If
            ' ici on gere le cas d'une moyenne qui ne peut etre calculer et qui nous donnerait une cellule vide
            If Err = 0 And i < ColDerniereValeur Then 'si err=0 c'est que la moyenne a pu etre calculee donc on incremente
                ColResultat = ColResultat + 1
            ElseIf Err <> 0 Then
                Err.Clear
            End If
        Loop
        MonTableau = .Range(.Cells(LigneResultat, 1), .Cells(LigneResultat, ColResultat)).Address
    End With
End Sub

voila cela devrait fonctionner

A+
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de bigfish_le vrai
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 8 juil. 2008 à 00:22
0
Utile
Salut,
si si c' est facile !


Si la seule règle est de faire une moyenne toute les 3 cellules,
il suffirait de faire, et tu l' as commpris, deux boucles sans se
soucier de savoir combien de cellules restent en fin de parcours.
-On récupère donc la taille du tableau.
Taille=UBound(T)
-On teste alors si taille<3
  Si oui , on fait notre moyenne et on n' en parle plus.
 Sinon
  on redimensionne notre tableau de telle façon que sa taille soit
un multiple de 3
Redim Preserve T(Int(Taille)*3)


 On declare un tableau des moyennes
 Dim Moyenne() As Double
 Redim Preserve Moyenne(UBound(T)/3) 
On declare une variable (VNN) qui me permet de savoir combien dans un
groupe de cellules j' ai des valeurs non nulles.
 Et declare une variable M qui me servira de Compteur pour le tableau des myennes




On fait enfin notre petit calcul
M=1
For i=1 To Taille Step 3
   VNN=0
   For j=0 To 2
   If T(i+j)<>Null Then
     Moyenne(M)=Moyenne(M)+T(i+j)
     VNN=VNN+1
  End If
   Moyenne(M)=Moyenne(M)/VNN
   M=M+1
Next




Et merci pour cette occasion de faire de la gym ..cérébrale.
On en discutera après..





<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 8 juil. 2008 à 00:25
0
Utile
oups, les premières failles !
- si taille<=3
-Redim Preserve T(Int(Taille/3)*3)

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 8 juil. 2008 à 00:41
0
Utile
salut,

tu parles de cellules et de tableau....
bon, à espérer que tu sois bien en VB6 (thème topic) et non pas en VBA :)

voici un petit exemple

Option Explicit
Option Base 1

Private Sub Form_Load()
'   3 tableaux pour l'exemple
    Dim avTab1 As Variant
    Dim avTab2 As Variant
    Dim avTab3 As Variant
    '
    Dim i As Integer, j As Integer, dSum As Double
    
    
'  
redim/remplissage des tableaux, pour le fun... :)
    avTab1 = Array(2, 3, 4, 5, 3, 2)     
'tableau de 1 à 6
    avTab2 = Array(2, 3, 4, 5, 3, 2, 8, 7,
5, 8) 'tableau
de 1 à 10
    avTab3 = Array(2, 3, 4, 5, 3, 2, 8, 7, 5, 8, 0, 2, 9, 8) 'tableau
de 1 à 14

    j = 0
    Debug.Print "TABLEAU 1"
    Debug.Print "========="
    For i = LBound(avTab1) To UBound(avTab1)
        j = j + 1
        dSum = dSum + CDbl(avTab1(i))
        If j = 3 Then
            Debug.Print "3 valeurs , MOY =
" & dSum / 3#
            j = 0
            dSum = 0
        End If
    Next i
    If j Then Debug.Print j & " valeur(s) , MOY =
" & dSum / j
    Debug.Print vbCrLf

    j = 0
    Debug.Print "TABLEAU
2"
    Debug.Print "========="
    For i = LBound(avTab2) To UBound(avTab2)
        j = j + 1
        dSum = dSum + CDbl(avTab2(i))
        If j = 3 Then
            Debug.Print "3 valeurs , MOY =
" & dSum / 3#
            j = 0
            dSum = 0
        End If
    Next i
    If j Then Debug.Print j & " valeur(s) , MOY =
" & dSum / j
    Debug.Print vbCrLf

    j = 0
    Debug.Print "TABLEAU
3"
    Debug.Print "========="
    For i = LBound(avTab3) To UBound(avTab3)
        j = j + 1
        dSum = dSum + CDbl(avTab3(i))
        If j = 3 Then
            Debug.Print "3 valeurs , MOY =
" & dSum / 3#
            j = 0
            dSum = 0
        End If
    Next i
    If j Then Debug.Print j & " valeur(s) , MOY =
" & dSum / j
    Debug.Print vbCrLf

Unload Me
End Sub

++
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp  
Commenter la réponse de PCPT
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 8 juil. 2008 à 01:24
0
Utile
Bonsoir PCPT,
j' ai testé ma méthde avec un exemple:
Option Explicit




Private Sub Command1_Click()
 Dim T() As Double
 Dim Moy() As Double
 ReDim Preserve T(8)
 T(1) = 5
 T(2) = 3
 T(3) = 4
 T(4) = 6
 T(5) = 2
 T(6) = 5
 T(7) = 6
 T(8) = 3
Dim TestTaille As Integer
TestTaille = Int(UBound(T) / 3)
If (TestTaille * 3) < UBound(T) Then _
    ReDim Preserve T(TestTaille * 3 + 3)


Debug.Print UBound(T)  '--->9


ReDim Preserve Moy(UBound(T) / 3)  '--->3




Dim VNN As Integer, M As Integer, i As Integer, j As Integer


M = 1
For i = 1 To UBound(T) Step 3
   VNN = 0
   For j = 0 To 2
   If T(i + j) <> 0 Then
     Moy(M) = Moy(M) + T(i + j)
     VNN = VNN + 1
  End If
  Next j
   Moy(M) = Moy(M) / VNN
   M = M + 1
Next i
For i = 1 To UBound(Moy)
  Debug.Print Moy(i)
Next
End Sub


''résultat
'4
'4.33333
'4.5


NB: c' est vrai qu' en ne sachant pas au départ
si c' est du VBA ou du VB6, je suis parti à
peu au hasard.





<hr />


... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 8 juil. 2008 à 01:47
0
Utile
salut LIBRE_MAX,

ta méthode sous entend qu'aucune valeur ne peut être à 0, ce qui fausse la donne ;)

<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp  
Commenter la réponse de PCPT
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 8 juil. 2008 à 01:57
0
Utile
au contraire.on excepte 0.
VNN ne s' incrémente que si la valeur<>0.
On calcule donc la moyenne à partir de la somme des valeur>0.
C' est la règle dans l 'Education Nationale, chez-nous,
en tout cas.

C ' est vrai que d' un autre côté si les 3 sont à 0, il y' aurai un bug   --->divisin par 0
Il faudra donc tester sur VNN avant.
<hr />
... Y'en a même qui disent qu'ils l'ont vu voler.     
Commenter la réponse de LIBRE_MAX
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 8 juil. 2008 à 02:14
0
Utile
si mes 0 n'avaient pas été comptés au bahut, je m'en serais sorti avec de bien meilleurs moyennes ;)
(j'ai jamais aimé les lundis et les vendredis ^^)

plus sérieusement chez nous, une mauvaise note n'a pas un coeff de 0 (au final)
Commenter la réponse de PCPT
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 8 juil. 2008 à 02:20
0
Utile
la note sanction chez nous c' est 0.1
Au fait, vous aviez quoi comme discipline le lundi et le mardi ?
J' ai mon idée là dessus, mais je te laisse l' avouer :-)

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 8 juil. 2008 à 02:24
0
Utile
oups !
plutôt les lundis et les vendredis

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 8 juil. 2008 à 07:19
0
Utile
Ah oui j'oubliais : n'oublis pas remplacer sheet1 par le non de ta feuille.
Tu peux aussi t'amuser a modifier le pas tu veras que cela fonctionne dans tout les cas de pas superieur a 1
Commenter la réponse de bigfish_le vrai
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 8 juil. 2008 à 12:45
0
Utile
Bien joué petit Filou, et la protectrice des animaux t'applaudit sans doute aussi
Commenter la réponse de PCPT
cs_pafacile 30 Messages postés vendredi 27 juin 2008Date d'inscription 22 juillet 2008 Dernière intervention - 8 juil. 2008 à 15:01
0
Utile
Salut vous!

Je vois que ca vous a motivé...lol

Je teste et je vous reviens la dessus...dans 1 heure.

Merci beaucoup de votre temps

Pafacile

PS: Je suis sur excel 2003...c'est VB6 ca?
Commenter la réponse de cs_pafacile
cs_pafacile 30 Messages postés vendredi 27 juin 2008Date d'inscription 22 juillet 2008 Dernière intervention - 8 juil. 2008 à 15:03
0
Utile
Ah...pas vu 2 eme page....

Désolé, à l'avenir je préciserai....

Bon je regarde Mr BigFish, et je reviens...

Merci quand même et au moins je sais que je suis en VBA maintenant....

Pafacile
Commenter la réponse de cs_pafacile
cs_pafacile 30 Messages postés vendredi 27 juin 2008Date d'inscription 22 juillet 2008 Dernière intervention - 8 juil. 2008 à 15:27
0
Utile
Ok, je pense que c'est nickel... Mais j'ai une erreur sur la ligne:

Application.WorksheetFunction.Average(.Range(.Cells(2, i - (Pas - 1)), .Cells(2, i)))

Il dit : Impossible de lire la propriété Average de la classe WorksheetFonction (erreur 1004)....

Ah oui et en fait mes resultats commencent bien sur la ligne 2 mais en C2... Ca va changer qqc?
Merci

Pafacile
Commenter la réponse de cs_pafacile
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 8 juil. 2008 à 16:23
0
Utile
Ah oui et en fait mes resultats commencent bien sur la ligne 2 mais en C2... Ca va changer qqc?



oui je viens de tester et cela impacte les resultats, remplace i 0 par i 2 en debut de sub

par contre pour l'erreur 1004 je comprend pas pourquoi car apparemmnet tu obtiens cette erreur en cour de route ou en fin de traitement. De mon coté j'ai fait pas mal de test pour obtenir cette erreur et je n'y arrive pas ! peux-tu me donner ton code pour voir comment tu as integre ce que je t'ai donné ?
Commenter la réponse de bigfish_le vrai
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 8 juil. 2008 à 16:42
0
Utile
Ah enfin j'y suis arrive a l'obtenir cette erreur 1004
si tu as un pas de cellule vide autrement dit, si tu demandes a la fonction average de calculer une moyenne a partir de cellules vides elle n'aime pas.

ajoute cette ligene(en bleu) :

On Local Error Resume Next
.Cells(LigneResultat, i).Value = Application.WorksheetFunction.Average(.Range(.Cells(2, i - (Pas - 1)), .Cells(2, i)))

A+
Commenter la réponse de bigfish_le vrai
cs_pafacile 30 Messages postés vendredi 27 juin 2008Date d'inscription 22 juillet 2008 Dernière intervention - 8 juil. 2008 à 17:44
0
Utile
Voila...

'Pour tracer les graphiques
Sub TracerGraphique()





'Déclarations de variables


Sheets("DONNÉES").Activate              'Activation de la feuille DONNÉES


Dim Site As String                      'Mise en mémoire des valeurs dans les variables
Site = Range("A1").Value
Dim Machine As String
Machine = Range("D3").Value
Dim Traitement As String
Traitement = Range("D5").Value
Dim Type_Verre As String
Type_Verre = Range("D7").Value
Dim Test As String



'Pour la variable test, cela dépend du choix de l'utilisateur!


If Range("A15").Value = "Bayer" Then
    Test = "Bayer"
End If
   
If Range("A15").Value = "Adhérance" Then
    Test = "Adhérance"
End If
   
 
' Vérifie que les valeurs contenus dans chaque cellule ne dépassent pas les limites permises pour chaque test


If Range("A15").Value = "Bayer" Then            ' Pour le test Bayer
    For Each cell In Range("B15:K15")
        If cell.Value > 10 Then
            cell.Select
            With Selection.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
            End With
            MsgBox "VALEURS INCORRECTS", 48, "Information fichier"
            msg = "Voulez-vous corriger les valeurs incorrectes ?"
            Style = vbYesNo + vbDefaultButton1
            Title = "Attention !"
            Réponse = MsgBox(msg, Style, Title)
                If Réponse = vbYes Then
                    ActiveCell.Select
                    Exit Sub
                End If
        Else
            cell.Select
            With Selection.Interior
                .ColorIndex = 0
                .Pattern = xlSolid
            End With
        End If
    Next
End If




If Range("A15").Value = "Adhérance" Then            'Pour le test Adhérance
    For Each cell In Range("B15:K15")
        If cell.Value > 5 Then
            cell.Select
            With Selection.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
            End With
            MsgBox "VALEURS INCORRECTS", 48, "Information fichier"
            msg = "Voulez-vous corriger les valeurs incorrectes ?"
            Style = vbYesNo + vbDefaultButton1
            Title = "Attention !"
            Réponse = MsgBox(msg, Style, Title)
                If Réponse = vbYes Then
                    ActiveCell.Select
                    Exit Sub
                End If
        Else
            cell.Select
            With Selection.Interior
                .ColorIndex = 0
                .Pattern = xlSolid
            End With
        End If
    Next
End If




       
Dim MonTableau As String        ' Ici les données vont être récupérées puis filtrées pour éviter les blancs si il y en a


    Sheets("DONNÉES").Range("A14:T15").Copy
    Worksheets.Add after:=Sheets(Worksheets.Count) 'creation d'une feuille temporaire en derniere position
    
                       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    With Selection
        .AutoFilter 'on active le filtre automatique
        .AutoFilter Field:=2, Criteria1:="<>" 'on applique les parametres de filtrage
        .Copy 'copy des données filtrées
    End With


    Sheets("DONNÉES").Activate  'retour sur la feuille source
                                                               
' Dépendament du test on pose les données à des endroits différents sur la feuille


If Test = "Bayer" Then
   
    Sheets("DONNÉES").Range("B36").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    MonTableau = Selection.Address      'on en profite pour recuperer l'adressedu nouveau tableau de données
    Application.DisplayAlerts = False   'on desactive les messages d'alertes pour la suppression de la feuille temporaire
    Sheets(Worksheets.Count).Delete     'on supprime la feuille temporaire
    Application.DisplayAlerts = True    'on réactive les messages d'alertes
   
    Range("B36:Z37").Select             ' Cache le nouveau tableau
    Selection.Font.ColorIndex = 2
    Range("A1").Select



'Sub bob() 'mais! qui c'est ce bob ?
    Dim ColDerniereValeur As Long, i As Long, Pas As Long, LigneResultat As Long
    LigneResultat = 38   ' Je veux les mettre a la ligne 38 (Je vais devoir tracer un graph apres avec, ce sera genre Periode1, periode 2 etc avec chaque moyenne calculée...en fait c'est exactement le meme ficjier que la derniere fois, simplement, je veux faire une courbe selon les moyennes...pas selon chaque valeur)
    Pas = 3
    i = 2
   
    With Sheets("DONNÉES") 'attention a partir d'ici tout les points sont OBLIGATOIR
        ' on efface la ligne de resultat au cas ou le nombre de valeur ou le pas aurait change
        .Rows(LigneResultat).ClearContents
       
        'recherche de la derniere colonne contenant une valeur
        ColDerniereValeur = .Rows(38).Find("*", , , , , xlByColumns, xlNext).Column
       
        ' une limitation au cas ou le pas serait plus grand que le nombre de valeur
        If Pas > ColDerniereValeur Then Pas = ColDerniereValeur
       
        ' on boucle tant que l'on est pas arrive a la derniere colonne(valeur)
        Do Until i >= ColDerniereValeur 'le signe > ne sert qu'a eviter de ce retrouver coince dans la boucle on ne sait jamais
            i = i + Pas
            ' calcul de la moyenne a l' aide de la fonction average d'excel
            'en VBA l'utilisation des fonctions via la propriete WorksheetFunction ce fait avec les fonctions anglaises
            ' les valeurs sont en ligne 38
            ' on pose le resultat toute les "Pas" colonnes en ligne LigneResultat... ok c'est pas tres francais mais j'aime bien ^^
            .Cells(LigneResultat, i).Value = Application.WorksheetFunction.Average(.Range(.Cells(38, i - (Pas - 1)), .Cells(38, i)))
            ' si le resultat de la soustraction est inferieur au pas
            ' c'est que le nonbre de valeurs(colonnes) n'est pas un multiple du pas
            ' mais il doit aussi etre plus grand que 1 car une moyenne sur une seul valeur cela n'a pas de sens
            If ColDerniereValeur - i < Pas And ColDerniereValeur - i > 1 Then                Pas ColDerniereValeur - i ' le pas nombre de valeurs restante
            ElseIf ColDerniereValeur - i = 1 Then
                Exit Do ' si il ne reste plus qu'une valeur on arrete tout
            End If
        Loop
 
    End With
'End Sub




    Charts.Add                          'creation du graphique
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source:=Sheets("DONNÉES").Range(MonTableau), PlotBy _
        :=xlRows
       
 ' Test si un graphique du même type existe deja et le supprime si oui en évitant l'affichage du message d'erreur
    Application.DisplayAlerts = False
    If WsExist(Test) Then
        Sheets(Test).Delete
    End If
    Application.DisplayAlerts = True
   
 ' Trace le graphique
      
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Test
   
    With ActiveChart
        .DisplayBlanksAs = xlInterpolated
        .HasTitle = True
        .ChartTitle.Characters.Text = (Site & " / " & Machine & " / " & Traitement & " / " & Type_Verre)
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Semaines"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = ("Résultats du Test " & Test)
    End With
    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
End If




If Test = "Adhérance" Then
   
    Sheets("DONNÉES").Range("B39").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    MonTableau = Selection.Address      'on en profite pour recuperer l'adresse du nouveau tableau de données
    Application.DisplayAlerts = False   'on desactive les messages d'alertes pour la suppression de la feuille temporaire
    Sheets(Worksheets.Count).Delete     'on supprime la feuille temporaire
    Application.DisplayAlerts = True    'on réactive les messages d'alertes
   
    Range("B39:Z40").Select             ' Cache le nouveau tableau
    Selection.Font.ColorIndex = 2
    Range("A1").Select


    Charts.Add                          'creation du graphique
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source:=Sheets("DONNÉES").Range(MonTableau), PlotBy _
        :=xlRows
       
 ' Test si un graphique du même type existe deja et le supprime si oui en évitant l'affichage du message d'erreur
    Application.DisplayAlerts = False
    If WsExist(Test) Then
        Sheets(Test).Delete
    End If
    Application.DisplayAlerts = True
   
 ' Trace le graphique
  
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Test
   
    With ActiveChart
        .DisplayBlanksAs = xlInterpolated
        .HasTitle = True
        .ChartTitle.Characters.Text = (Site & " / " & Machine & " / " & Traitement & " / " & Type_Verre)
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Semaines"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = ("Résultats du Test " & Test)
    End With
    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
End If


   
 ' Fait un dégradé pour le fond du graphique (celui ci dépend encore du test)


    If ActiveChart.Name = "Bayer" Then


 
        Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1
        With Selection
            .Fill.Visible = True
            .Fill.ForeColor.SchemeColor = 4
            .Fill.BackColor.SchemeColor = 3
        End With
    Else
        Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1
        With Selection
            .Fill.Visible = True
            .Fill.ForeColor.SchemeColor = 3
            .Fill.BackColor.SchemeColor = 4
        End With
    End If
 
 ' Trace une courbe de tendance polynomiale d'ordre n
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlPolynomial, Order:=4 _
        , Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
        False).Select
    ActiveChart.PlotArea.Select
    With ActiveChart
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlValue, xlPrimary) = True
    End With
   
 ' Limite la graduation des axes abcisses et ordonnées (Dépend encore du test)
 
  If ActiveChart.Name = "Bayer" Then
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScale = 7
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    Else
        ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScale = -0.1
        .MaximumScale = 5.5
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
  End If
End Sub
--------------------------------------------



' Fonction qui test si un graphique du même type existe déjà (Rattaché à  Sub TracerGraphique() )
Function WsExist(Nom$) As Boolean
On Error Resume Next
WsExist = Sheets(Nom).Index
End Function

Merci encore...
Pafacile
Commenter la réponse de cs_pafacile
cs_pafacile 30 Messages postés vendredi 27 juin 2008Date d'inscription 22 juillet 2008 Dernière intervention - 8 juil. 2008 à 18:08
0
Utile
La ligne:
ColDerniereValeur = .Rows(38).Find("*", , , , , xlByColumns, xlNext).Column

Affiche aussi une erreur...:  Variable de bloc with non definie...Pourtant elle est definie...

Là c'est Pafacile....
Commenter la réponse de cs_pafacile

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

faire des moyennes sur un tableau qui varie...? - page 2