Problème fonction "Ecart type"

**johannj** · 01/09/2009, 16h05

Bonjour le forum,

Je n'arrive pas à utiliser la fonction "écart type" dans une macro.
Chaque fois que je lance la macro, une erreur 1004 se produit: impossible de lire la proprieté!! Tout fonctionne bien avec la fonction moyenne... Je ne comprends pas ce qu'il se passe

Voici le code utilisé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
        With TreatedFile
        moyenne = Application.WorksheetFunction.Average(Range("G3:G" & i + 3))
        bla = Application.WorksheetFunction.StDev(Range("G3:G" & i + 3))
        End With

Quelqu'un aurait-il une idée SVP

??
johann

**Krovax** · 01/09/2009, 16h15

Bonjour
A quoi sert le bloc with puisque tu ne l'utilise pas? enlève le, le code sera plus lisible.
Chez moi aucun souci, où est le code commet l'appelle tu?

**johannj** · 01/09/2009, 16h22

Bonjour Krovax,

Avec ou sans bloc with, j'ai toujours la meme erreur...
Le plus insensé, c'est que cette fonction marche très bien dans d'autres macros

!!

voici le code entier de ma macro (la partie qui nous intéresse est en rouge):

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
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Sub Contact_Resistance()

Dim WB As Workbook, TreatedFile As Workbook

Dim Counter As Variant

Dim a As Integer, dl As String, i As Integer, j As Integer, l As Integer

Dim Rcontact() As Variant
Dim Deviation() As Variant
Dim tableau As Variant

Dim moyenne As Variant
Dim dev As String
Dim chemin As String
Dim run As String
Dim sheetreconnaissance As String
Dim separationcharacter As String

Application.ScreenUpdating = False    

run = InputBox("Run Number?")
If run = "" Then Exit Sub

separationcharacter = InputBox("Enter your separation character:")
If VarType(Counter) = vbBoolean Then GoTo suite

suite:
Set WB = ThisWorkbook

Counter = Application.GetOpenFilename("*,*", , , , True) 'Ouverture de la boite de dialogue pour selection des fichiers .txt
If VarType(Counter) = vbBoolean Then Exit Sub

j = 4
l = 4

For a = 1 To UBound(Counter)
    Set TreatedFile = Application.Workbooks.Open(Counter(a), xlMDOS)
    dl = Range("A65536").End(xlUp).Row - 2
    i = 0
    ReDim Rcontact(dl)
    ReDim Deviation(dl)
    
    tableau = Split(TreatedFile.Name, separationcharacter)
    nom = tableau(0)

    For i = 0 To dl - 1
        
        
        Rcontact(i) = TreatedFile.Worksheets(1).Range("G" & i + 3).Value
        Deviation(i) = TreatedFile.Worksheets(1).Range("H" & i + 3).Value
        

        moyenne = Application.WorksheetFunction.Average(Range("G3:G" & i + 3))
        dev = Application.WorksheetFunction.StDev(Range(Cells(3, 7), Cells(i + 3, 7)))

                  
        If UBound(tableau) > 0 Then
            If a Mod 2 = 0 Then
                WB.Worksheets(1).Cells(l + 1, i + 8).Value = Rcontact(i)
                WB.Worksheets(1).Cells(l + 2, i + 8).Value = Deviation(i)
                If i = dl - 1 Then l = l + 5
            Else
                WB.Worksheets(1).Cells(j + 1, i + 2).Value = Rcontact(i)
                WB.Worksheets(1).Cells(j + 2, i + 2).Value = Deviation(i)
                If i = dl - 1 Then
                    WB.Worksheets(1).Cells(j, 1).Value = nom
                    WB.Worksheets(1).Cells(j + 3, 2).Value = moyenne
                    'WB.Worksheets(1).Cells(j + 3, 3).Value = bla
                    WB.Worksheets(1).Cells(j + 1, 1).Value = "RContact (mOhms.cm2)"
                    WB.Worksheets(1).Cells(j + 1, 1).Characters(2, 7).Font.Subscript = True
                    WB.Worksheets(1).Cells(j + 1, 1).Characters(19, 1).Font.Superscript = True
                    WB.Worksheets(1).Cells(j + 2, 1).Value = "Individual Deviation"
                    WB.Worksheets(1).Cells(j + 3, 1).Value = "RContact Average & Deviation"
                    WB.Worksheets(1).Cells(j + 3, 1).Characters(2, 7).Font.Subscript = True
                    'WB.Worksheets(1).Range(.Cells(3, 2), .Cells(3, dl + 1)).Font.Bold = True
                
                    j = j + 5
                End If
            End If
        Else
            WB.Worksheets(1).Cells(j + 1, i + 2).Value = Rcontact(i)
            WB.Worksheets(1).Cells(j + 2, i + 2).Value = Deviation(i)
            If i = dl - 1 Then
                WB.Worksheets(1).Cells(j, 1).Value = Split(TreatedFile.Name, ".")
                WB.Worksheets(1).Cells(j + 3, 2).Value = moyenne
                'WB.Worksheets(1).Cells(j + 3, 3).Value = dev
                WB.Worksheets(1).Cells(j + 1, 1).Value = "RContact (mOhms.cm2)"
                WB.Worksheets(1).Cells(j + 1, 1).Characters(2, 7).Font.Subscript = True
                WB.Worksheets(1).Cells(j + 1, 1).Characters(19, 1).Font.Superscript = True
                WB.Worksheets(1).Cells(j + 2, 1).Value = "Individual Deviation"
                WB.Worksheets(1).Cells(j + 3, 1).Value = "RContact Average & Deviation"
                WB.Worksheets(1).Cells(j + 3, 1).Characters(2, 7).Font.Subscript = True
                'WB.Worksheets(1).Range(.Cells(3, 2), .Cells(3, dl + 1)).Font.Bold = True
                       ' .Range(.Cells(j, 1), .Cells(j, 1)).Interior.ColorIndex = 15
                        '.Range(.Cells(j + 3, 1), .Cells(j + 3, 1)).Interior.ColorIndex = 15
                j = j + 5
            End If
        End If
    Next i

    
    TreatedFile.Close
    
    
Next a       'fin de la boucle
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

With WB
    .Worksheets(1).Cells.NumberFormat = "0.000"
    .Worksheets(1).Columns.AutoFit
    .Worksheets(1).Rows(3).RowHeight = 20
End With
   
chemin = Application.GetSaveAsFilename("Contact Resistance_Resume Run " & run, ", *.xls")
WB.SaveAs (chemin)

Set WB = Nothing
Set TreatedFile = Nothing

End Sub

Désolé pour la couleur noire du code... que se passe t-il?
ci joint, des exemples de fichiers à traiter.

Chez moi, ça ne fonctionne toujours pas !!

**Krovax** · 01/09/2009, 17h22

Envoyé par johannj

Désolé pour la couleur noire du code... que se passe t-il?

Parce que tu as mis du rouge du coup la mise en forme automatique est désactivé si tu veux signaler une zone fait le avec des commentaire, c'est beaucoup plus simple pour nous.

La macro plante dès i=0 ou c'est pour une valeur particulière? (lance ta macro en pas a pas)

**mercatog** · 01/09/2009, 17h57

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
        With TreatedFile.Worksheets(1)
        moyenne = Application.WorksheetFunction.Average(.Range("G3:G" & i + 3))
        bla = Application.WorksheetFunction.StDev(.Range("G3:G" & i + 3))
        End With

les .Range peut être

spécifier de quel range s'agit t il

edit

**Fvandermeulen** · 01/09/2009, 18h26

Salut à tous,
Selon mois pas besoin du 'WorksheetFunction' ceci doit être suffisant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dev = Application.StDev(Sheets(1).Range(Cells(3, 7), Cells(i + 3, 7)))

Reste à adapter avec ta feuille.

A+

**johannj** · 02/09/2009, 08h54

Bonjour à tous et merci de votre aide!!

Quelques nouvelles suite à vos mails d'hier

Merci Krovax pour le coup de la mise en forme, comme quoi, il n'y a pas qu'avec les macros qu'il me faut faire des progrès

!!
Concernant la macro, celle-ci plante dès i=0 (merci pour ton astuce de pas à pas

)

mercatog, ta suggestion de mettre des points ne résout pas le problème. A vrai dire, ce fut l'une des premières choses que j'ai faite

Fvandermeulen, merci, ta solution fonctionne très bien, à condition que dev soit déclarée comme variant.

En résumé, le problème est résolu mais l'incompréhension demeure de mon coté. Questions:
1) pourquoi cette fonction fonction dans d'autres macros et pas celles-ci?
2) pourquoi en enlevant le "worksheetfunction" cela fonctionne t-il?
3) pourquoi le "worksheetfunction.Average" fonctionne t-il toujours , contrairement à "StDev", pour toutes les macros et même avec le "worksheetfunction"??

A part une mauvaise humeur de mon excel et du pc, je ne vois pas trop!!

Dans tous les cas, merci de votre aide. Si vous avez des réponses aux questions, je suis aussi preneur

Johann

Problème fonction "Ecart type"

Macros et VBA Excel

Discussions similaires

Partager

Partager