Faire une régression automatique avec une condition

Version imprimable

19/11/2015, 13h36
GauthierH

Faire une régression automatique avec une condition

Bonjour,
j 'ai une problématique un peu complexe sous VBA (fichier joint) ou j'aimerai faire une régression polynomiale (ax2+bx+c ou fonction DroiteReg sous excel avec VBA, en modifiant la sélection des x et Y que je veux prendre dans ma régression.

Quelqu'un est il capable de faire un code VBA qui automatiserait l'action de régression avec une condition

Merci beaucoup d'avance pour vos réponses.

Fichiers joints dans les discussions

1 pièce(s) jointe(s)

Salut Gauthier,

As-tu essayé avec l'enregistreur de macro?

Bon voici un début car je ne sais pas comment fonctionne ta formule???
Je l'ai mise sous forme de "function"

A toi de me dire si je m'approche du résultat :mouarf:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub RegressionPoly() Dim RegP As Integer, Val1 As Integer, Val2 As Integer 'Regression poly With Feuil1 Val1 = .Range("E3") Val2 = .Range("F3") RegP = RegPoly(Val1, Val2) 'inscrit le résultat dans la cellule D7 .Range("D7") = RegP End With End Sub Function RegPoly(Val1 As Integer, Val2 As Integer) As Integer FormulaLocal = "=DROITEREG(Val1,Val2,VRAI,VRAI)" End Function
Rendu:
Pièce jointe 193265

A+

bonjour Sebphyto,
Merci pour ta réponse.
La fonction que tu donne permets de faire une régression sur deux chiffres donc c'est top.
Par contre dans mon exemple j'aurais besoin de faire une régression sur des colonnes d'un tableau mais sachant que j'aimerai ajouter une condition pour que la régression ne prenne pas toutes les valeur des colonnes comme expliqué dans l'exemple.
Saurais tu comment faire?

En regardant sur des forum j ai l impression qu'il faudrait que je cré un tableau VBA du type Array pour stcker les valeurs que je souhaites sélectionnées depuis la BD excel et faire la régression sur ce tableau Array.
Mais ca m'a l air bien compliqué... Quelqu'un saurait faire?

bonjour, quelqu'un aurait il une solution à mon problème? est ce que le probleme est clair et réalisable sous vba?

Je suis un peu perdu (étant débutant en VBA j 'ai du mal à trouver la bonne syntax/fonction), j 'ai essayé le code suivant mais il doit être plein d'erreur:
Quelqu'un se sent il une ame de professeur et m'aider à faire le bon code?
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 'Création du tableau colonne Y et X à utiliser pour la régression Sub Tableau() 'la dimension de la colonne X et de la colonne Y du tableau VBA à créer n'ait (la dimension du tableau dépend du nombre de lignes pour lesquelles on a le meme product et la meme date de Maturité don je mets n Dim VectorX(1 To n), VectorY(1 To n) Dim ntotal As Integer, n As interger, i As Integer, j As Integer, k As Integer, ref As Double Dim a As Double, b As Double, c As Double n = 100000 'Par défault, ce vecteur sera redimensionné ensuite ntotal = .Range("C2").Value 'création du tableau pour la premiere valeur Y (colonne D) nulle rencontrée j = 1 For i = 1 To ntotal If Cells(4 + i, 4).Value = "" Then Cells(4 + i, 4).Value = ref For j = 1 To ntotal If Cells(4 + i, 1).Value = ref Then Cells(4 + i, 4).Value = VectorY(k) Cells(4 + i, 5).Value = VectorX(k) k = k + 1 End If Next j n = k 'pour redimensionner les vecteurs VectorX et Vector à la bonne dimension (nombres de valeurs que l'on a remplies) ' A ce stade, pour la premiere valeur Y nulle (D8 ici) nous avons rempli deux colonnes X(k), Y(k) avec uniquement les valeurs Y et X ont le meme product et Maturity date (concaténé en ref colonne 1) que la cellule D8 en question. ' If faut ensuite faire la régression avec ces deux colonnes 'La formule ci dessous devrait permettre de récupérer les coefficient de régression Y = aX^2 +bX + c a = Application.Index(Application.LinEst(VectorY, Application.Power(VectorX, Array(1, 2)), True, True), 1) b = Application.Index(Application.LinEst(VectorY, Application.Power(VectorX, Array(1, 2)), True, True), 2) c = Application.Index(Application.LinEst(VectorY, Application.Power(VectorX, Array(1, 2)), True, True), 3) 'Ces coefficients peuvent être stockés dans les colonnes G, H et I Cells(4 + i, 7).Value = a Cells(4 + i, 7).Value = b Cells(4 + i, 7).Value = c End If Next i End Sub
merci bcp d'avance pour votre aide !

07/12/2015, 20h26
clementmarcotte

http://www.developpez.net/forums/d84...s-discussions/
08/12/2015, 02h03
Sebphyto

Bonsoir Gauthier,

Citation:

La fonction que tu donne permets de faire une régression sur deux chiffres donc c'est top

Une chose positive
La ça devient différent de ton sujet initial

Citation:

j'aurais besoin de faire une régression sur des colonnes d'un tableau

Combien de colonnes? nombre de ligne? colonne et ligne Fixent ou évolutives???

Citation:

j'aimerai ajouter une condition pour que la régression ne prenne pas toutes les valeur des colonnes

quels genres de conditions? sur quels critères???

Citation:

comme expliqué dans l'exemple

lequel? dans ton post initial?

Citation:

Saurais tu comment faire?

Peut-être mais il va falloir m'expliquer un peu plus et pas seulement à moi ;)

Citation:

j 'ai essayé le code suivant

Ouais, mais est-il vraiment adapté à ton besoin? parce que c du lourd, entre-autre les commentaires dans ton code, franchement...:aie:

Dans le souci de t'aider

Seb

1 pièce(s) jointe(s)

Probleme simplifié

Bonjour Sebphyto,
merci pour ta réponse, j 'ai simplifié fortement la question et le fichier joint en espérant que ce soit compréhensible maintenant.

Dans le fichier joint j ai, 4 colonnes:
une colonne (C) réference (valeurs A ou B)
une colonne (D) de valeurs Y (chiffres)
deux colonnes de valeurs X (colonne E) et X^2 (colonne F) (chiffres)

Les colonnes de X et X^2 sont pleines mais pour la colonne Y certaines valeurs sont manquantes.
Je cherche à recalculer les valeurs de Y manquantes en considérant les valeurs de X et X^2 et en ayant une équation du type Y = a*X2 + b*X + c
Les coefficient a,b et c pouvant être déterminer à partir des autres couples (Y,X,X^2) lorsqu'ils ont la meme référence (A ou B).

J'ai fait le code ci-dessous pour cela:

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
 
'Création du tableau colonne Y et X à utiliser pour la régression
Sub Tableau()
'la dimension de la colonne X et de la colonne Y du tableau VBA à créer n'ait pas connu à ce stade. je la note n, elle sera déterminée plus bas
Dim VectorX(1 To n), VectorY(1 To n)
Dim ntotal As Integer, n As interger, i As Integer, j As Integer, k As Integer, ref As String
Dim a As Double, b As Double, c As Double
 
n = 100000 'valeur par défaut pour ne pas limiter la taille du vecteur. Ce vecteur sera redimensionné par la suite plus bas
ntotal = .Range("C2").Value 'Sur excel je calcul la taille de la base de donnée
j = 1
 
'Pour chaque valeur Y manquante (colonnes D) , récupération de la valeur de la Référence (colonne C)
For i = 1 To ntotal
    If Cells(4 + i, 4).Value = "" Then 'recherche des valeurs Y vide
        Cells(4 + i, 3).Value = ref 'ref est la valeur de la référence. pour D10, ref = A
        For j = 1 To ntotal 'Pour les valeurs Y vides identifiées ci dessus, reparcourir le tableau et stocker les valeurs des colonnes D et E ayant la meme référence
            If Cells(4 + i, 3).Value = ref Then
                Cells(4 + i, 4).Value = VectorY(k)
                Cells(4 + i, 5).Value = VectorX(k)
                k = k + 1
            End If
        Next j
        n = k 'pour redimensionner les vecteurs VectorX et VectorY à la bonne dimension (nombres de valeurs que l'on a remplies)
        ' A ce stade nous avons recréer deux vecteurs X(k), Y(k) avec uniquement les valeurs Y et X qui ont la même référence que la valeur manquante à recalculer (D10)
        ' If faut ensuite faire la régression avec Y(k), X(k)^2 et X(k)
 
    'La formule ci dessous devrait permettre de récupérer les coefficient de régression Y = aX^2 +bX + c
    a = Application.Index(Application.LinEst(VectorY, Application.Power(VectorX, Array(1, 2)), True, True), 1)
    b = Application.Index(Application.LinEst(VectorY, Application.Power(VectorX, Array(1, 2)), True, True), 2)
    c = Application.Index(Application.LinEst(VectorY, Application.Power(VectorX, Array(1, 2)), True, True), 3)
 
    'Ces coefficients peuvent être stockés dans les colonnes G, H et I
    Cells(4 + i, 7).Value = a
    Cells(4 + i, 7).Value = b
    Cells(4 + i, 7).Value = c
    'Je n'ai pas trouvé la formule pour récupérer le coefficient R2 de régression
 
    End If
Next i
 
End Sub

Je joins aussi le fichier au cas ou avec plus d 'explications.
En très résumé on peut dire que mon problème revient à faire sous VBA une régression polynomiale (degré 2) sur des vecteurs en intégrant une condition pour ne faire la régression que sur une partie des données des vecteurs.
Merci d'avance pour votre aide.
Gauthier

20/12/2015, 11h22
Sebphyto

Salut Gauthier,

Bon bah désolé mais là ça me dépasse!!!!!:aie::aie:
Moi et la comprehension de la regression poly....c'est du lourd :weird:

Désolé mais je ne vais pas pouvoir aller plus loin.....

seb

R² est donnée directement par droitereg.

ce code n'est pas optimal et pour un nombre important de donnée ça risque de ramer. Je l'ai mis ici pour illustration.

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
Option Explicit
 
Sub RegPoly()
Dim LastLig As Long, i As Long
Dim Vx(), Vy()
Dim j As Byte
Dim Tb, Res
 
Application.ScreenUpdating = False
With Feuil1
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    If LastLig > 4 Then
        Tb = .Range("C5:J" & LastLig)
        For i = 1 To UBound(Tb, 1)
            If Tb(i, 2) = "" Then
                Remplir Tb, Tb(i, 1), Vx, Vy
                Res = Application.LinEst(Vy, Vx, True, True)
                For j = 1 To 3
                    Tb(i, 4 + j) = Res(1, j)
                Next j
                Tb(i, 8) = Res(3, 1) 'R²
                .Range("C5:J" & LastLig) = Tb
            End If
        Next i
    End If
End With
End Sub
 
Private Sub Remplir(ByVal Tb, ByVal ref As String, ByRef Vx(), ByRef Vy())
Dim i As Long, N As Long
 
Erase Vx
Erase Vy
For i = 1 To UBound(Tb, 1)
    If Tb(i, 1) = ref Then
        If Tb(i, 2) <> "" Then
            N = N + 1
            ReDim Preserve Vx(1 To 2, 1 To N)
            Vx(1, N) = Tb(i, 3)
            Vx(2, N) = Tb(i, 3) ^ 2
            ReDim Preserve Vy(1 To N)
            Vy(N) = Tb(i, 2)
        End If
    End If
Next i
End Sub