La meilleure régression

Version imprimable

Bonjour le Forum !

Je suis actuellement en train de créer un programme VBA afin de traiter des fichiers avec certaines données ! Jusque là ca va ^^
Une fois les données récupérées de plusieurs fichiers, je dois corréler ces données avec d'autres que l'utilisateur aura entré manuellement dans un userform.
Pour ces corrélations, il me faut créer la courbe puis des courbes de tendance.
- 1 régression linéaire
- 4 régressions polynomiales
Le facteur R² des ces régressions m'aide à décider laquelle je dois garder (de régression).

J'espère que c'est assez clair !! Si non hésiter pas à me demander.

J'ai quelques soucis (sinon je ne serais certainement pas là à réclamer votre aide) :

1) l'exécution automatique du programme (donc non pas à pas) ne me donne pas les valeurs que pourtant j'arrive à avoir en pas à pas !

2) j'aimerais connaitre l'indice d'un tableau que j'ai créé correspondant à la plus grande valeur de ce tableau.
J'aurais bien utiliser application.max(montab) mais ca me renvoie 0.

3) J'ai une erreur d'exécution à ce niveau là de mon programme

Code:

1
2
3
4
5
6
For ordre = 1 To 5
    If ordre <> meilleur Then
    ActiveChart.SeriesCollection(1).Trendlines(ordre).Select
    Selection.Delete
    End If
Next

Je vous colle la partie de mon programme qui me pose soucis, si vous etes motivés pour m'aider je ne dis pas non à un peu d'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
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
Sub recap()
Dim montab(5) As Variant
rang3 = Worksheets("DonnéesCorrélations").UsedRange.Rows.Count
 
' Supprimer anciens graphs '
        For Each Legraphe In ActiveSheet.ChartObjects
            Legraphe.Delete
        Next
 
' Boucle afin de faire TOUT les graph
 
For k = 1 To 2
i = 1
li = 2
col = 1
    For l = 1 To 4
        For m = 1 To 5
 
    ' Ajouter nouveau graph '
            ActiveSheet.Shapes.AddChart.Select
 
    ' Supprimer séries déjà affichées '
            Do Until ActiveChart.SeriesCollection.Count = 0
                ActiveChart.SeriesCollection(1).Delete
            Loop
 
    ' Choix type de courbe '
            ActiveChart.ChartType = xlXYScatterLines
 
    ' Choix et ajout des séries '
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.HasTitle = True
                abscisse k, l
                ordonnée m
 
    ' Facteur de corrélation '
        ' on fait toutes les régressions '
For ordre = 1 To 5
    If ordre = 1 Then
        ActiveChart.SeriesCollection(1).Trendlines.Add
        ActiveChart.SeriesCollection(1).Trendlines(ordre).Select
        Selection.DisplayRSquared = True
        rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines("" & ordre).DataLabel.Text, 6)
        montab(ordre) = rdeux
    Else
        ActiveChart.SeriesCollection(1).Trendlines.Add
        ActiveChart.SeriesCollection(1).Trendlines("" & ordre).Select
        With Selection
            .Type = xlPolynomial
            .Order = ordre
        End With
        Selection.DisplayRSquared = True
        rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines("" & ordre).DataLabel.Text, 6)
        montab(ordre) = rdeux
    End If
    MsgBox montab(ordre)
Next
 
        ' on ne prend en compte qu'une régression '
 
MsgBox Application.Max(montab())
 
' NE MARCHE PAS
'ordre = 5
'While ordre > 1
'    If montab(ordre) < montab(ordre - 1) Then
 '       meilleur = ordre - 1
 '   ElseIf montab(ordre) = montab(ordre - 1) Then
 '       meilleur = ordre - 1
 '   ElseIf montab(ordre) > montab(ordre - 1) Then
 '       meilleur = ordre
 '   End If
 '   ordre = ordre - 1
'MsgBox meilleur
'Wend
 
 
For ordre = 1 To 5
    If ordre <> meilleur Then
    ActiveChart.SeriesCollection(1).Trendlines(ordre).Select
    Selection.Delete
    End If
Next
            'Range("F" & li + 4).Value =
 
    ' Mise en place des graphiques '
    If k = 1 Then
                With Worksheets("Récapitulatif")
                    .ChartObjects(i).Top = .Rows(li).Top
                    .ChartObjects(i).Left = .Columns(col).Left
                    .ChartObjects(i).Height = 165.75
                    .ChartObjects(i).Width = 300
                End With
    Else
                With Worksheets("Récapitulatif1")
                    .ChartObjects(i).Top = .Rows(li).Top
                    .ChartObjects(i).Left = .Columns(col).Left
                    .ChartObjects(i).Height = 165.75
                    .ChartObjects(i).Width = 300
                End With
    End If
i = i + 1
li = li + 13
        Next
    Next
    Worksheets("Récapitulatif1").Select
Next
 
End Sub
 
Private Sub abscisse(k, l)
If k = 1 Then
    If l = 1 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$F$1:$F$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$F$4:$F" & rang3
    ElseIf l = 2 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$G$1:$G$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$G$4:$G" & rang3
    ElseIf l = 3 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$H$1:$H$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$H$4:$H" & rang3
    ElseIf l = 4 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$I$1:$I$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$I$4:$I" & rang3
    End If
ElseIf k = 2 Then
    If l = 1 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$J$1:$J$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$J$4:$J" & rang3
    ElseIf l = 2 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$K$1:$K$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$K$4:$K" & rang3
    ElseIf l = 3 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$L$1:$L$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$L$4:$L" & rang3
    ElseIf l = 4 Then
        ActiveChart.SeriesCollection(1).Name = "='DonnéesCorrélations'!$M$1:$M$2"
        ActiveChart.SeriesCollection(1).Values = "='DonnéesCorrélations'!$M$4:$M" & rang3
    End If
End If
End Sub

Merci d'avance,

TotalJim

05/12/2014, 09h50
totaljim

1 pièce(s) jointe(s)

Bonjour le forum,

Bon comme je vois que vous avez l'air plutot motivé sur mon problème je vais vous joindre le fichier pour que vous puissiez tester et me dire d'où viennent les problèmes !!
05/12/2014, 10h59
pgz
Bonjour.

Juste un petit coup de main.
Pour ton code de recherche du max, il me semble que tu n'initialises pas la variable meilleur.
Code:

1 2 3 4 5 ' NE MARCHE PAS, à faire marcher 'ordre = 5 meilleur = montab(ordre) 'While ordre > 1 ...
Par ailleurs, tu as beaucoup d'activation d'objets. C'est ce qu'on obtient en enregistrant des macros, mais ce n'est pas le plus rapide. Par exemple, au lieu de
Code:

1 2 3 4 5 6 For ordre = 1 To 5 If ordre <> meilleur Then ActiveChart.SeriesCollection(1).Trendlines(ordre).Select Selection.Delete End If Next
tu peux faire
Code:

1 2 3 4 5 For ordre = 1 To 5 If ordre <> meilleur Then ActiveChart.SeriesCollection(1).Trendlines(ordre).Delete End If Next
Et aussi remplacer ActiveChart par une instance du chart. Mais ça n'explique pas l'erreur. Es-tu sûr qu'à ce moment tu as bien 5 trendlines pour ta série ?

Citation:

j'aimerais connaitre l'indice d'un tableau que j'ai créé correspondant à la plus grande valeur de ce tableau.

A ma connaissance, cela n'existe pas mais tu peux facilement coder une telle fonction.

Cordialement,

PGZ
05/12/2014, 11h58
totaljim
Bonjour pgz et merci de me répondre (enfin quelqu'un !! Alléluia !!)

Je viens de tester, j'ai bien 5 valeurs dans mon tableau montab.

Par contre au moment de les supprimer ça en supprime 3 et plante à partir de la 4eme. J'ai essayé de remplacer la condition du if ( ordre <> meilleur) par une valeur fixe (ordre<>4) et il supprime les 3 premieres (comme d'habitude) saute la 4eme (vu que ordre est égal à 4) puis plante sur la 5eme.
Ca refuse de me supprimer plus de 3 courbes j'ai l'impression.
La variable meilleur, en affichant avec un MsgBox, ne m'affiche rien.
Ce devrait pas me donner une valeur ca : meilleur = Application.Max(montab()) ??

Ne nous soucions plus du problème de meilleur, normalement c'est réglé avec ca ! A moins que je me sois trompé ce qui suit devrait me donner le plus petit indice de la plus grande valeur (je veux le plus petit polynome qui a la plus grande valeur ! ex montab(3)=montab(4)=montab(5) je veux meilleur = 3)
Code:

1 2 3 4 5 6 7 8 ' détermine l'indice du tableau du meilleur R²' meilleur = 1 ordre = 1 For ordre = 1 To 4 If montab(ordre) < montab(ordre + 1) Then meilleur = ordre + 1 End If Next
Citation:

Et aussi remplacer ActiveChart par une instance du chart.

C'est à dire ?

EDIT !

Re,

Pour supprimer les trendlines tu peux essayer
Code:

1 2 3 4 5 6 For ordre = 5 To meilleur+1 step -1 ActiveChart.SeriesCollection(1).Trendlines(ordre).Delete Next ordre For ordre = meilleur-1 To 1 step -1 ActiveChart.SeriesCollection(1).Trendlines(ordre).Delete Next ordre
Parce que quand tu supprime la trendlines(1), la (2) devient (1), ... Tu vois le truc ?

Pour instancier ton chart tu peux faire

Code:

Set oNewChart = ActiveSheet.Shapes.AddChart

Et encore remplacer ActiveSHeet par une instance de la bonne feuille...

Cordialement,

PGZ

05/12/2014, 19h39
Marc-L

Bonjour, bonjour !

Citation:

Envoyé par totaljim

Bonjour pgz et merci de me répondre (enfin quelqu'un !! Alléluia !!)

Et oui ici c'est le forum des formules de feuille de calculs ! Pas du tout celui dédié au VBA !
Qui plus est le forum VBA est deux fois plus fréquenté, c'est ballot ! …
08/12/2014, 10h04
totaljim

Bonjour Marc-L et pgz et le reste du forum !

Citation:

Et oui ici c'est le forum des formules de feuille de calculs ! Pas du tout celui dédié au VBA !

En effet ca pourrait expliquer certaines choses :mrgreen:

Bon pgz j'ai essayé ton code pour supprimer les trendlines ... c'est parfait, et j'ai capté ce que tu voulais dire donc tout va bien sur ce point.

Par contre j'ai bien toujours mon problème exécution automatique/ pas-à-pas.
Est ce que pourrait venir de mon pc ?

Citation:

Pour instancier ton chart tu peux faire
Set oNewChart = ActiveSheet.Shapes.AddChart
Et encore remplacer ActiveSHeet par une instance de la bonne feuille...

Qu'est ce que ca change

Code:

Set oNewChart = ActiveSheet.Shapes.AddChart

par rapport à

Code:

ActiveSheet.Shapes.AddChart.Select

??
08/12/2014, 15h31
pgz

Bonjour.

Quand tu instancies un objet, tu ne le sélectionnes pas et tu ne l'actives pas. Du coup, c'est plus sûr pour les instructions suivantes et plus rapide en exécution. C'est justement le genre de truc qui peut faire qu'un code s'exécute bien en pas à pas, et pas en normal.

Cordialement,

PGZ
08/12/2014, 16h05
totaljim

Re,

J'ai remplacé

Code:

ActiveSheet.Shapes.AddChart.Select

par ça

Code:

Set oNewChart = ActiveSheet.Shapes.AddChart

Mais du coup j'ai du rajouter ça

Code:

ActiveSheet.ChartObjects(i).Select

Tout ça pour qu'au final je retombe avec le même soucis :mrgreen:

Bon j'ai fais des tests et la ligne qui pose problème c'est celle la (la vilaine)

Code:

rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(ordre).DataLabel.Text, 6)

Je suis persuadé que c'est celle la car un donnant des valeurs à mon tableau au départ (montab(1)=6, montab(2)=6,...) apres avoir copier rdeux dedans, je n'ai plus aucunes valeurs.
j'ai donc testé rdeux avec un MsgBox juste après la ligne que je vous ai copié plus haut et ... rien !!

Si quelqu'un avait une autre méthode pour récupérer le coefficient de régression je suis preneur !!

J'attends votre expertise :)
Merci de m'aider, je sens qu'avec vous le problème ne va pas durer !!
08/12/2014, 19h50
pgz

Bonsoir.

Si c'est après avoir supprimé toutes les autres trendlines du graph, je te propose

Code:

rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text, 6)

Cordialement,

PGZ

Bonjour pgz, le forum !

Bon j'ai suivi ton idée et j'ai testé ça

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
For ordre = 1 To 5
                If ordre = 1 Then
                    ActiveChart.SeriesCollection(1).Trendlines.Add
                    ActiveChart.SeriesCollection(1).Trendlines(1).Select
                    Selection.DisplayRSquared = True
                    rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text, 6)
                    MsgBox rdeux  'test'
                    montab(ordre) = rdeux
                Else
                    ActiveChart.SeriesCollection(1).Trendlines.Add
                    ActiveChart.SeriesCollection(1).Trendlines(1).Select
                    With Selection
                        .Type = xlPolynomial
                        .Order = ordre
                        .DisplayRSquared = True
                    End With
                    rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text, 6)
                    MsgBox rdeux  'test'
                    montab(ordre) = rdeux
                End If
                ActiveChart.SeriesCollection(1).Trendlines(1).Delete
            Next
 
'test'
            For j = 1 To 5
            MsgBox montab(j)
            Next
 
' détermine l'indice du tableau du meilleur R²'
            meilleur = 1
            For ordre = 1 To 4
                If montab(ordre) < montab(ordre + 1) Then
                    meilleur = ordre + 1
                End If
            Next
            Range("J" & i) = meilleur
            Range("K" & i) = montab(meilleur)
 
' Ajoute la meilleure régression
            If ordre = 1 Then
                    ActiveChart.SeriesCollection(1).Trendlines.Add
                    ActiveChart.SeriesCollection(1).Trendlines(1).Select
                    Selection.DisplayRSquared = True
            Else
                    ActiveChart.SeriesCollection(1).Trendlines.Add
                    ActiveChart.SeriesCollection(1).Trendlines(1).Select
                    With Selection
                        .Type = xlPolynomial
                        .Order = ordre
                        .DisplayRSquared = True
                    End With
            End If

Cela devrait revenir au même, et c'est exactement le cas ! J'ai toujours le même problème, aucunes valeurs en automatique et ca marche très bien en pas-à-pas !

Ce problème commence à devenir un poil agacant !

11/12/2014, 13h33
pgz

Bonjour.

A ce stade, je crois que tu peux joindre ton classeur, s'il n'y a rien de confidentiel.

Cordialement,

PGZ
11/12/2014, 16h07
totaljim

1 pièce(s) jointe(s)

Voilà mon travail, en espérant que vous trouverez une coquille et surtout que ce soit la bonne coquille :D
12/12/2014, 14h20
totaljim

Bonjour pgz, le forum,

As tu testé mon code ?
Dis moi que chez toi non plus l'exécution automatique ne fonctionne pas et que tu as trouvé pourquoi !!
Ou si c'est pas le cas ... je crois que ce projet va nécessiter quelques allégements :calim2:

Bonjour à tous,

J'ai tenté en ajoutant une tempo juste avant tes rdeux=

Code:

Application.Wait Now() + CDate("00:00:01")

Je n'ai pas eu la patience d'attendre la fin mais le debug.print me montrait des valeurs pour rdeux.
Tu as d'autres méthodes de tempo pour descendre sous la seconde. Par exemple : http://www.cpearson.com/excel/WaitFunctions.aspx

eric

EDIT :
Une simple petite boucle semble suffire.
Et tu peux sécuriser pour avoir un message en cas de valeur non désirée sur rdeux, pour la régler sur la vitesse de ton micro.

Remplacer (2 fois) rdeux=... par :
Code:

1 2 3 4 5 6 For ci = 1 To 2 DoEvents Next ci rdeux = Right(ActiveChart.SeriesCollection(1).Trendlines(ordre).DataLabel.Text, 6) If IsError(rdeux) Then cj = cj + 1: Debug.Print "cj= " & cj If rdeux = "" Then ck = ck + 1: Debug.Print "ck= " & ck
et en fin de procédure :

Code:

If cj Or ck Then MsgBox "IsError(rdeux) : " & cj & vbLf & "rdeux = """" : " & ck

Il y a une erreur à la fin dans ' Mise en place des graphiques ' mais qui n'a rien à voir apparemment.

eric

15/12/2014, 14h20
totaljim

Bonjour à tous,

eriiic, je viens de tester la solution de ton EDIT et, ca marche !
Par contre j'ai pas compri pourquoi !
J'aime bien savoir où je fais des erreurs pour pouvoir ne pas retomber dans la meme situation plusieurs fois

Pourrais tu m'expliquer ce que réalisent ces quelques lignes de codes stp ?
15/12/2014, 15h45
eriiic

Elles prennent un peu de temps en donnant la main à windows pour qu'il effectue les autres tâches en attente, c'est tout, c'est à la place d'une tempo.
Ca laisse le temps à tes opérations précédentes de se finir pour récupérer le résultat.
eric
15/12/2014, 16h18
totaljim

Merci eriiic, franchement merci !
j'avais déja testé avec des tempo mais ca ne fonctionnait pas bien !

Merci à tout les autres aussi !

On se reverra surement sur d'autres sujets :)

A bientot,
TotalJim