calcule de moyenne sur une ligne

Version imprimable

28/06/2012, 20h46
revans

calcule de moyenne sur une ligne

bonjour ,

alors j'ai lue un tuto sur la fonction average mais je n'arrive pas a l'appliquer comme je le veux

j'aimerais fais les moyennes de Cells(1+i, nbcycle + 3) avec for i = 0 to 720et coller cela sur With Worksheets("cylindre" & (cyi)).Cells("nbcycle+4:3+i") avec for cyi = 1 to nbcylindre ici nbcylindre est egale a 4 mais il est variable

si quelqu'un peut m'aider sur cela

Bonjour,

Peux tu expliquer en français car ta syntaxe VBA étant très approximative, ma compréhension à ton problème n'est pas complète

Il me semble avoir compris ce genre de chose, mais pas sur.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim Sh As Worksheet
Dim i As Long
 
'Boucle sur toutes les feuilles du classeur
For Each Sh In ThisWorkbook.Worksheets
 
    'Si la feuille est une feuille cylindre
    If Left(LCase(Sh.Name), 8) = "cylindre" Then
        'de la ligne 2 à 720
        For i = 2 To 720
            'Appliquer la moyenne
 
            'Dans quelle colonne mettre le résultat et faire la moyenne de quoi ?
 
        Next i
 
    End If
 
Next Sh

j'aimerais faire les moyennes des mes ligne de Cells(1+i, nbcycle + 3) et que cette moyenne soit dans ("cylindre" & (cyi)).Cells("nbcycle+4:3+i")

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
sub Macro2()
'
'Ouvrire boite de dialogue
 
Application.Dialogs(xlDialogOpen).Show
'copie du fichier
       Range("A1:E57618").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add before:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Sheets("Feuil1").Name = "donner traiter"
 
'suppresion d'une ligne sur deux
 
Dim i As Long
 
For i = Range("A" & Rows.Count).End(xlUp).Row To 20 Step -2
    Rows(i).Delete
Next i
 'copie des cycles
    Set Plage = Sheets("donner traiter").Range("A18")
    Set Plage = Range(Plage, Plage.End(xlDown))
    Plage.Copy
 
    'Création des feuilles et collage
    nbfeuilles = Sheets("donner traiter").Range("C11")
    For i = 1 To nbfeuilles
        Sheets.Add after:=Sheets(Worksheets.Count)
        Sheets(Worksheets.Count).Name = "Cylindre" & i
        Range("A2").PasteSpecial xlPasteAll
    Next i
 
    Application.CutCopyMode = False
    'copie des cycles et copie sur chaque feuilles
    nbcylindre = Sheets("donner traiter").Range("C11")
  For i = 1 To nbcylindre
  Set Plage = Sheets("donner traiter").Cells(17, 1 + i)
 
    Set Plage = Range(Plage, Plage.End(xlDown))
    Plage.Copy
    Sheets("cylindre" & (i)).Cells(1, 2).PasteSpecial
    Next i
 
    Application.CutCopyMode = False
 
 
 
 Dim nbcycle  As Integer
    nbcycle = Sheets("donner traiter").Range("C12")
 
    Dim cyi As Integer
    Dim bloci As Integer
 'Boucle sur les cylindres
    For cyi = 1 To nbcylindre
 
 
        Worksheets("cylindre" & (cyi)).Cells(1, 3 + bloci).Value = "cycle" & bloci & "/" & nbcycle
 'Boucle sur les blocs de 720 pts
        For bloci = 0 To nbcycle - 1
           With Worksheets("donner traiter")
               .Range(.Cells(19 + bloci * 720, cyi + 1), .Cells(16 + (bloci + 1) * 720, cyi + 1)).Copy
           End With
 'créations des titres
           With Worksheets("cylindre" & (cyi))
                .Cells(1, 3 + bloci).Value = "Cycle" & (bloci + 1)
               .Cells(2, 3 + bloci).PasteSpecial (xlPasteValues)
           End With
        Next bloci
    Next cyi
    'création titre Moyenne
     For cyi = 1 To nbcylindre
 
      With Worksheets("cylindre" & (cyi))
      .Cells(1, nbcycle + 3).Value = "Moyenne"
                End With
            Next cyi
            'création des moyennes
 
 
End Sub

28/06/2012, 23h10
jfontaine

Citation:

Cells(1+i, nbcycle + 3) et que cette moyenne soit dans ("cylindre" & (cyi)).Cells("nbcycle+4:3+i")

C'est justement cela que je voudrais que tu écrives en français (a cette heure, pas le courage de lire tout ton code :?)
28/06/2012, 23h19
revans

alors fais la moyenne de la ligne 1 de mes 40cycles puis de la ligne 2 puis la 3
et qu'elle soit coller en 43 et cela pour chaque feuille de cylindre1 a cylindre4

je comprend toujours pas l'outils moyenne et la fonction average , help

Bonjour revans,

Essaies :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub moyennesur40ccellulespuis720lignespuis4onglets()
 
Dim nbcycle, cyi, nbcylindre  As Integer
 
nbcycle = 40
nbcylindre = 4
 
For cyi = 1 To nbcylindre
    With Worksheets("cylindre" & (cyi))
        For i = 1 To 720
            .Cells(i, 43).Value = Application.Average(.Range(.Cells(i, 1), .Cells(i, nbcycle)))
        Next
    End With
Next
 
End Sub

Utilises Application.Average pour pointer vers une plage de cellules.

J'espère avoir compris ton problème (sinon il faudra nous joindre un modèle).

Bertrand

01/07/2012, 00h24
revans

alors j'ai aucune valeur mais juste ceci #DIV/0!

Bonsoir,

C'est normal comme erreur... surtout si ta ligne est vide ;)
En essayant de diviser par zéro, le calcul provoque une erreur.

Il te faut tester ta ligne au préalable et en fonction du résultat, lancer ou non le calcul.

Le test "si la somme des cellules est nul" alors indiquer "Vide" sinon faire le calcul.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub moyennesur40ccellulespuis720lignespuis4ongletsV2()
 
Dim nbcycle, cyi, nbcylindre  As Integer
 
nbcycle = 40
nbcylindre = 4
 
For cyi = 1 To nbcylindre
    With Worksheets("cylindre" & (cyi))
        For i = 1 To 720
            If Application.WorksheetFunction.Sum(.Range(.Cells(i, 1), .Cells(i, nbcycle))) = 0 Then
                .Cells(i, 43).Value = "VIDE"
            Else
                .Cells(i, 43).Value = Application.Average(.Range(.Cells(i, 1), .Cells(i, nbcycle)))
            End If
        Next
    End With
Next
 
End Sub

Bertrand

01/07/2012, 10h55
Didier Gonard

Bonjour,

On peut éviter de faire 720 itérations dans une boucle en affectant tout sur une ligne genre pour une plage de référence A1:J21 et les moyennes en L :

Code:

Range(Cells(1, 12), Cells(21, 12)).FormulaR1C1 = "=AVERAGE(RC[-11]:RC[-2])"

Sinon, pour tester si sa ligne n'est pas vide, passer par sum fait qu'on ne prend pas en compte le cas ou tout a une valeur, mais =0 et la moyenne serait OK et égale à 0 aussi du coup...

Cordialement,

Ps : si le côté technique de la réponse = OK ou pas => pensez à cliquer sur les pouces et quand question résolue à la taguer résolue, et chaque action vous rapporte des points

Didier
01/07/2012, 18h28
revans

toujours toute les lignes avec VIDE
peut etre par ce que mes valeur ne commence qu'a la colonne 3 et pas depuis tout le debut?

Bonsoir,

Si cela note "VIDE", c'est qu'elles le sont. Fait des tests avec plus de données pour vérifier.

Je t'ai modifié le code pour partir de la 3ème colonne, mais attention --> le résultat de la moyenne va être affecté en colonne 44 puisque si je décale ton tableau de 3 colonnes, il va atteindre la colonne 43 (3+nbcycle=3+40=43) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub moyennesur40ccellulespuis720lignespuis4ongletsV2() Dim nbcycle, cyi, nbcylindre As Integer nbcycle = 40 nbcylindre = 4 For cyi = 1 To nbcylindre With Worksheets("cylindre" & (cyi)) For i = 1 To 720 If Application.WorksheetFunction.CountA(.Range(.Cells(i, 3), .Cells(i, nbcycle + 3))) = 0 Then .Cells(i, 44).Value = "VIDE" Else .Cells(i, 44).Value = Application.Average(.Range(.Cells(i, 3), .Cells(i, nbcycle + 3))) End If Next End With Next End Sub
Pour tenir compte de la remarque de Didier

Citation:

Envoyé par Ormonth

Sinon, pour tester si sa ligne n'est pas vide, passer par sum fait qu'on ne prend pas en compte le cas ou tout a une valeur, mais =0 et la moyenne serait OK et égale à 0 aussi du coup...

j'ai remplacé le

Code:

Application.WorksheetFunction.Sum

par

Code:

Application.WorksheetFunction.CountA

Même si la somme est égale à zéro, il y aura un calcul de moyenne et un résultat égal à 0.

Tiens nous au courant de ton avancée.

Bertrand

alors toujours que des vide alors que mes valeur existe.
voila mon code si sa peut aider

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Sub Macro2()
'
'Ouvrire boite de dialogue
 
Application.Dialogs(xlDialogOpen).Show
'copie du fichier
       Range("A1:E57618").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add before:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Sheets("Feuil1").Name = "donner traiter"
 
'suppresion d'une ligne sur deux
 
Dim i As Long
 
For i = Range("A" & Rows.Count).End(xlUp).Row To 20 Step -2
    Rows(i).Delete
Next i
 'copie des cycles
    Set Plage = Sheets("donner traiter").Range("A18")
    Set Plage = Range(Plage, Plage.End(xlDown))
    Plage.Copy
 
    'Création des feuilles et collage
    nbfeuilles = Sheets("donner traiter").Range("C11")
    For i = 1 To nbfeuilles
        Sheets.Add after:=Sheets(Worksheets.Count)
        Sheets(Worksheets.Count).Name = "Cylindre" & i
        Range("A2").PasteSpecial xlPasteAll
    Next i
 
    Application.CutCopyMode = False
    'copie des cycles et copie sur chaque feuilles
    nbcylindre = Sheets("donner traiter").Range("C11")
  For i = 1 To nbcylindre
  Set Plage = Sheets("donner traiter").Cells(17, 1 + i)
 
    Set Plage = Range(Plage, Plage.End(xlDown))
    Plage.Copy
    Sheets("cylindre" & (i)).Cells(1, 2).PasteSpecial
    Next i
 
    Application.CutCopyMode = False
 
 
 
 Dim nbcycle  As Integer
    nbcycle = Sheets("donner traiter").Range("C12")
 
    Dim cyi As Integer
    Dim bloci As Integer
 'Boucle sur les cylindres
    For cyi = 1 To nbcylindre
 
 
        Worksheets("cylindre" & (cyi)).Cells(1, 3 + bloci).Value = "cycle" & bloci & "/" & nbcycle
 'Boucle sur les blocs de 720 pts
        For bloci = 0 To nbcycle - 1
           With Worksheets("donner traiter")
               .Range(.Cells(19 + bloci * 720, cyi + 1), .Cells(16 + (bloci + 1) * 720, cyi + 1)).Copy
           End With
 'créations des titres
           With Worksheets("cylindre" & (cyi))
                .Cells(1, 3 + bloci).Value = "Cycle" & (bloci + 1)
               .Cells(2, 3 + bloci).PasteSpecial (xlPasteValues)
           End With
        Next bloci
    Next cyi
    'création titre Moyenne
     For cyi = 1 To nbcylindre
 
      With Worksheets("cylindre" & (cyi))
      .Cells(1, nbcycle + 3).Value = "Moyenne"
                End With
            Next cyi
            'création des moyennes
 
For cyi = 1 To nbcylindre
    With Worksheets("cylindre" & (cyi))
        For i = 1 To 720
            If Application.WorksheetFunction.Sum(.Range(.Cells(i, 3), .Cells(i, nbcycle + 3))) = 0 Then
                .Cells(i + 1, nbcycle + 3).Value = "VIDE"
            Else
                .Cells(i + 1, nbcycle + 3).Value = Application.Average(.Range(.Cells(i + 1, 3), .Cells(i + 1, nbcycle + 3)))
            End If
        Next
    End With
Next

01/07/2012, 22h49
Bear the french

Bonsoir revans,

Envoies un fichier en enlevant tout ce qui peut être confidentiel.
ça doit fonctionner mais nous sommes peut-être passé à côté d'une information (?).

Bertrand
01/07/2012, 23h58
revans

1 pièce(s) jointe(s)

voici mon fichier source
Pièce jointe 98139

Bonjour Revans,

Au regard du fichier que tu as transmis, il peut y avoir un problème... Les décimaux étant désignés par des points alors qu'il faut des virgules pour excel.

Il faut donc transformer tes cellules au "bon format" avec un code

Code:

1
2
3
4
5
For Each cell In .Range(.Cells(1, 3), .Cells(720, nbcycle + 3))
            If InStr(1, cell.Text, ".") > 0 Then
                cell.Value = CDbl(Val(cell.Text))
            End If
Next

et l’insérer au bon endroit dans le code général :

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
Sub moyennesur40ccellulespuis720lignespuis4ongletsV2()
 
Dim nbcycle, cyi, nbcylindre As Integer
nbcycle = 40
nbcylindre = 4
 
For cyi = 1 To nbcylindre
    With Worksheets("cylindre" & (cyi))
 
        For Each cell In .Range(.Cells(1, 3), .Cells(720, nbcycle + 3))
            If InStr(1, cell.Text, ".") > 0 Then
                cell.Value = CDbl(Val(cell.Text))
            End If
        Next
 
        For i = 1 To 720
            If Application.WorksheetFunction.CountA(.Range(.Cells(i, 3), .Cells(i, nbcycle + 3))) = 0 Then
                .Cells(i, 44).Value = "VIDE"
            Else
                .Cells(i, 44).Value = Application.Average(.Range(.Cells(i, 3), .Cells(i, nbcycle + 3)))
            End If
        Next
    End With
Next
 
End Sub

Sinon, hormis cette modification, le code fonctionne chez moi ;)

Bertrand

02/07/2012, 09h03
Didier Gonard

1 pièce(s) jointe(s)

Bonjour,

voir si pas possibilité de le faire en direct lors de l'import ;) cf image (autre fichier, mais idem / séparateurs)

Pièce jointe 98142

Cordialement,

Ps : si le côté technique de la réponse = OK ou pas => pensez à cliquer sur les pouces et quand question résolue à la taguer résolue, et chaque action vous rapporte des points

Didier
02/07/2012, 19h43
revans

c'est super ça fonctionne
maintenant je voudrais faire un graph mais avec le 2007 je ne comprend pas trop , quand je choissie graph ligne il me demande pas de choissir mes donner
02/07/2012, 22h14
Bear the french

Citation:

Envoyé par revans

maintenant je voudrais faire un graph mais avec le 2007 je ne comprend pas trop , quand je choissie graph ligne il me demande pas de choissir mes donner

Bonsoir Revans,

Il s'agit d'une question trop éloignée du titre de ton post, à l'origine "calcul de moyenne sur une ligne".

Il te faut clore ce sujet en l'indiquant comme résolu (si c'est le cas) et ouvrir un nouveau post avec ta nouvelle question en rapport au graphe (tu peux y inclure un lien avec ce post là).

C'est important de respecter cette méthode car les questions que tu te poses, d'autres forumeurs se les posent aussi et il faut donc leur faciliter la tache (A une question/problématique doit correspondre une réponse ou un "résolu").

Bertrand