faire des moyennes sur un tableau qui varie...?Résolu

Question

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

bigfish_le vrai · Accepted Answer

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

LIBRE_MAX · Answer

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

... Y'en a même qui disent qu'ils l'ont vu voler.

LIBRE_MAX · Answer

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.

PCPT · Answer

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

LIBRE_MAX · Answer

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.

... Y'en a même qui disent qu'ils l'ont vu voler.

PCPT · Answer

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

LIBRE_MAX · Answer

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.

... Y'en a même qui disent qu'ils l'ont vu voler.

PCPT · Answer

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)

LIBRE_MAX · Answer

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.

LIBRE_MAX · Answer

oups !
plutôt les lundis et les vendredis 

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.

bigfish_le vrai · Answer

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

PCPT · Answer

Bien joué petit Filou, et la protectrice des animaux t'applaudit sans doute aussi

cs_pafacile · Answer

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?

cs_pafacile · Answer

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

cs_pafacile · Answer

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

bigfish_le vrai · Answer

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é ?

bigfish_le vrai · Answer

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+

cs_pafacile · Answer

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

cs_pafacile · Answer

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

bigfish_le vrai · Answer

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+

Faire des moyennes sur un tableau qui varie...?

25 réponses

Votre réponse

Discussions similaires