Discussion :

[Nicoyong]

Bonjour la communauté.
Je viens solliciter votre aide car je voudrais manipuler par macro des courbes de tendances polynomiales.
Voilà où j'en suis je récupère mon nuage de points dans une variable tableau à deux dimensions

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
n = 8
ReDim Mesures(n, 2)
If Cells(34, 16).Value <> "" Then
        j = 34
    Else
        j = 36
    End If
 
    For i = 0 To n - 1 Step 1 
        Mesures(i, 0) = Cells(j, 3).Value  'valeur X
        Mesures(i, 1) = Cells(j, 16).Value 'valeur Y
        j = j + 2 
    Next

Cela fonctionne très bien. Là où je bloque c'est quand j'essaye de convertir les formules Excel suivantes en macro

Polynomiale : y = ax2+bx+c (degré 2)
a = INDEX(DROITEREG(Données_Y;Données_X^{1.2};1;1);1;1)
b = INDEX(DROITEREG(Données_Y;Données_X^{1.2};1;1);1;2)
c = INDEX(DROITEREG(Données_Y;Données_X^{1.2};1;1);1;3)
r² = INDEX(DROITEREG(Données_Y;Données_X^{1.2};1;1);3;1)

Je pense qu'il n'y a rien de compliqué mais comprenant déjà pas tout à fait les arguments de ces formules je n'arrive pas à les convertir en code VBA. Je vous remercie d'avance de l'aide que vous pouvez m'apporter.

[jurassic pork]

hello,
tu peux essayer quelque chose comme ceci (testé avec Excel 2016) :

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
Sub CalculEquation()
Dim a, b, c, i, r², x, xsq, y
Dim polynome
'ax²+bx+c
x = Range("Données_X")
' on construit un tableau à 2 dimensions x et x²
xsq = x
ReDim Preserve xsq(1 To UBound(xsq), 1 To 2)
'on calcule x au carré
For i = 1 To UBound(xsq)
    xsq(i, 2) = xsq(i, 1) * xsq(i, 1)
Next i
y = Range("Données_Y")
polynome = Application.WorksheetFunction.LinEst(y, xsq, True, True)
a = polynome(1, 1) 'a
b = polynome(1, 2) 'b
c = polynome(1, 3) 'c
r² = polynome(3, 1) 'r²
Debug.Print "a = " & a
Debug.Print "b = " & b
Debug.Print "c = " & c
Debug.Print "r² = " & r²
End Sub

Feuille de départ :



Résultat :

a = -0,388131313131313
b = 4,26944444444444
c = -3,34555555555555
r² = 0,924972341303924

Classeur en pièce jointe.

Ami calmant, J.P

[Nicoyong]

Bonjour et merci à toi Jurassic pork. Cela fonctionne très bien pour moi, il y a pas mal de choses dans le code que je n'ai pas compris il va falloir que j'étudie ça de plus près mais encore un tout gros merci

[Nicoyong]

Bonjour, j'espère que vous suivez toujours cette discussion. Je n'arrive pas à intégrer votre code à mes besoins. Je rencontre des problèmes à identifier de quel type sont les variables. Je suppose que je ne les utilise pas correctement du coup et je n'arrive pas à redimensionner la matrice xsq. Voici mon début de code je vous remercie pour l'attention portée à ce poste.

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
Sub corection_ipi()
'-----Déclaration variable-----
    Dim x() As Double
    Dim y() As Double
    Dim xsq() As Double
    Dim polynome
    Dim Da As Double
    Dim Db As Double
    Dim i As Single
    Dim j As Single
    Dim n As Single
    Dim r² As Double
    Dim LimiteR² As Double
'-----------------------------
 
'-----Supretion des anciennes valeurs-----
    Cells(23, 14).Value = ""
'-----------------------------
 
If Cells(26, 1).Value = "" Or Cells(34, 16).Value = "" Or Cells(36, 16).Value = "" Or Cells(38, 16).Value = "" Or Cells(40, 16).Value = "" Or Cells(42, 16).Value = "" Or Cells(44, 16).Value = "" Then Exit Sub 'S'il n'y l'anneau n'a pas été sélectionné ou pas de valeur pour les enfoncements à 1. 25 à 7.5 la macro s'arrêtant
 
'-----Configuration des variables-----
    limitR² = 0.99 'Détermine la limite acceptable de R²
    j = 34
'-----------------------------
 
'-----Récupération des données-----
    Debug.Print "Données recuper" & Chr(10) & "x   =   y"
    For i = 0 To 7 Step 1 'Boucle permettant de récupérer les valeurs
        If Cells(j, 16).Value <> "" Then
            ReDim Preserve x(i + 1)
            ReDim Preserve y(i + 1)
            x(i) = Cells(j, 3).Value
            y(i) = Cells(j, 16).Value
            j = j + 2
            Debug.Print x(i) & " = " & y(i)
        End If
    Next i
'-----------------------------
 
'-----Analyse & ajustement la courbe du ²-----
    xsq = x
    ReDim Preserve xsq(1 To UBound(xsq), 1 To 2)
    'on calcule x au carré
    For i = 1 To UBound(xsq)
        xsq(i, 2) = xsq(i, 1) * xsq(i, 1)
    Next i
    polynome = Application.WorksheetFunction.LinEst(y, xsq, True, True)
    ............

[jurassic pork]

hello,
que se passe-t-il ? Peux-tu mettre un classeur avec tes données d'entrée dedans si ce n'est pas confidentiel ?
Ami calmant, J.P

[Nicoyong]

Bonjour, ci-joint un extrait de mon tableau en vous remerciant d'avance. Sondage VDevelopeur2.xls