problème programmation VBA

2 pièce(s) jointe(s)

Bonjour à tous,

Je débute dans la programmation VBA et j'ai un gros souci pour la réalisation d'une macro.

J'ai déjà commencé la programmation mais je bloque.
Il y a un erreur au niveau de la boucle For, de ce fait je n'arrive pas à continuer la programmation.

Je vous joins le fichier que j'ai commencé.

Merci pour votre aide.

De quelle boucle For tu parles? Montre ton code et où tu bloques?

Bonsoir,
j'ai mis la ligne de commande en rouge.
merci pour votre aide

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
Dim X, S
Dim Ligne, Nb_Xi
Dim Xetoil, Setoil As Double
Dim Xietoil, Phi As Double
Dim Xi_Tableau() As Double
Dim Cpt As Integer
Dim Xi_Tableau_X As Variant

Sub Tableau()

    'Trier les données du plus petit au plus grand
        ActiveWorkbook.Worksheets("Données").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Données").Sort.SortFields.Add Key:=Range("B2:B15") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
    With ActiveWorkbook.Worksheets("Données").Sort
        .SetRange Range("B1:B15")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        
    End With

    'Stockage de données dans un"tableau"
                Ligne = 2
                Nb_Xi = 0

   Do While Worksheets("Données").Cells(Ligne, 2).Value <> ""
        ReDim Preserve Xi_Tableau(Nb_Xi)
        Xi_Tableau(Nb_Xi) = Worksheets("Données").Cells(Ligne, 2).Value
    
        Nb_Xi = Nb_Xi + 1
        Ligne = Ligne + 1
    Loop

    'Ecrire dans une ligne après x données entrées non définies
        Application.Worksheets("Données").Cells(Ligne + 1, 1).Value = "Moyenne"
        Application.Worksheets("Données").Cells(Ligne + 2, 1).Value = "Ecart-Type"
        Application.Worksheets("Données").Cells(Ligne + 3, 1).Value = "Moyenne Robuste"
        Application.Worksheets("Données").Cells(Ligne + 4, 1).Value = "Ecart-Type Robuste"
        Application.Worksheets("Données").Cells(Ligne + 5, 1).Value = "Phi"

    'Appliquer les formules dans une ligne après x données entrées non définies
        Application.Worksheets("Données").Cells(Ligne + 1, 2).Value = WorksheetFunction.Average(Xi_Tableau)
        Application.Worksheets("Données").Cells(Ligne + 2, 2).Value = WorksheetFunction.StDev(Xi_Tableau)
        Application.Worksheets("Données").Cells(Ligne + 3, 2).Value = WorksheetFunction.Median(Xi_Tableau)
        Application.Worksheets("Données").Cells(Ligne + 4, 2).Value = 1.483 * WorksheetFunction.Median(Xi_Tableau)
        Application.Worksheets("Données").Cells(Ligne + 5, 2).Value = 1.5 * 1.483 * WorksheetFunction.Median(Xi_Tableau)

    'Calculs et variables
    
        X = WorksheetFunction.Average(Xi_Tableau)
        S = WorksheetFunction.StDev(Xi_Tableau)
        Xetoil = WorksheetFunction.Median(Xi_Tableau)
        Setoil = 1.483 * WorksheetFunction.Median(Xi_Tableau)
        Phi = 1.5 * 1.483 * WorksheetFunction.Median(Xi_Tableau)
        Xietoil = 1.483 * WorksheetFunction.Median(Xi_Tableau) - 1.5 * 1.483 * WorksheetFunction.Median(Xi_Tableau)

    Boucle de 0 à ....
    
        For Cpt = 0 To Nb_Xi - 1
            ReDim Preserve Xi_Tableau_X(Cpt)
            Xi_Tableau_X(Cpt) = Abs(Xi_Tableau(Cpt) - Xetoil)
        Next Cpt
        



    'Conditionnement de la comparaison

'    If Xistar < Xstar - Phi Then
'        Application.Worksheets("Données").Cells(Ligne + 6, 1).Value = "Xi*"
'        Application.Worksheets("Données").Cells(Ligne + 6, 2).Value = 1.483 * WorksheetFunction.Median(Xi_Tableau) - 1.5 * 1.483 * WorksheetFunction.Median(Xi_Tableau)
'    Else
'        If Xistar < Xstar + Phi Then
'        Application.Worksheets("Données").Cells(Ligne + 6, 1).Value = "Xi*"
'        Application.Worksheets("Données").Cells(Ligne + 6, 2).Value = 1.483 * WorksheetFunction.Median(Xi_Tableau) + 1.5 * 1.483 * WorksheetFunction.Median(Xi_Tableau)
'        End If
'    Else
''la je ne sais pas c'est Xi
'Application.Worksheets("Données").Cells(Ligne + 6, 1).Value = "Xi*"
'
'    End If

End Sub

Citation:

Envoyé par skippy80

Bonsoir,
j'ai mis la ligne de commande en rouge.
merci pour votre aide
...
For Cpt = 0 To Nb_Xi - 1
ReDim Preserve Xi_Tableau_X(Cpt)
Xi_Tableau_X(Cpt) = Abs(Xi_Tableau(Cpt) - Xetoil)
Next Cpt
...

bonsoir,
Tu dois initialiser le variant Xi_Tableau_X en tableau d'abord depuis l'extérieur de la boucle, à l'aide de l'instruction Redim, avant d'instruire avec Redim Preserve.
comme ceci:

Code:

Redim Xi_Tableau_X(0)

Ok, merci. Maintenant la boucle fonctionne correctement. En fait il faut vraiment penser à tout pour la programmation mais je n'ai que 4h de cours derrière moi.

Merci d'avance