Multiples régressions avec plages variables

**vbondoma** · 13/07/2018, 13h11

Bonjour à tous,

J'ai un code qui effectue plusieurs régressions linéaires avec des séries dont la longueur est non fixe.
J'ai 18 variables à expliquer (colonne C à U) que je régresse avec 1 variable explicative (colonne B)
[code]Option Explicit
Sub Calcul_régression()
'
' Calcul_régression Macro
'Suprime les données et les bordures des précédentes regressions
'Sélectionne l'ensemble des données non vides d'une colonne
'Calcule l'ensemble des régressions des différents secteurs et enregistre les données dans la feuille "regression taux longs"
'Copie le nom du secteur correspondant à la regession dans la feuille "données" et le colle en face de la cellule "Rapport détaillé" de la feuille Reg_taux_longs

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
Dim dest As Worksheet
Dim source As Worksheet
Dim dernlig As Long
 
Set dest = ThisWorkbook.Sheets("Reg_taux_longs")
Set source = ThisWorkbook.Sheets("Données")
dernlig = source.Range("C" & Rows.Count).End(xlUp).Row
dest.Cells.ClearContents
dest.Cells.Borders(xlDiagonalDown).LineStyle = xlNone
dest.Cells.Borders(xlDiagonalUp).LineStyle = xlNone
dest.Cells.Borders(xlEdgeLeft).LineStyle = xlNone
dest.Cells.Borders(xlEdgeTop).LineStyle = xlNone
dest.Cells.Borders(xlEdgeBottom).LineStyle = xlNone
dest.Cells.Borders(xlEdgeRight).LineStyle = xlNone
dest.Cells.Borders(xlInsideVertical).LineStyle = xlNone
dest.Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
 
     Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$C$5:$C$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$1:$I$18"), False, False, False, False, , False
        dest.Range("B1").FormulaR1C1 = "=Données!R[3]C[1]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$D$5:$D$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$20:$I$38"), False, False, False, False, , False
        dest.Range("B20").FormulaR1C1 = "=Données!R[-16]C[2]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$E$5:$E$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$40:$I$58"), False, False, False, False, , False
        dest.Range("B40").FormulaR1C1 = "=Données!R[-36]C[3]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$F$5:$F$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$60:$I$78"), False, False, False, False, , False
        dest.Range("B60").FormulaR1C1 = "=Données!R[-56]C[4]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$G$5:$G$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$80:$I$98"), False, False, False, False, , False
        dest.Range("B80").FormulaR1C1 = "=Données!R[-76]C[5]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$H$5:$H$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$100:$I$118"), False, False, False, False, , False
        dest.Range("B100").FormulaR1C1 = "=Données!R[-96]C[6]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$I$5:$I$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$120:$I$138"), False, False, False, False, , False
        dest.Range("B120").FormulaR1C1 = "=Données!R[-116]C[7]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$J$5:$J$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$140:$I$158"), False, False, False, False, , False
        dest.Range("B140").Select
    ActiveCell.FormulaR1C1 = "=Données!R[-136]C[8]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$K$5:$K$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$160:$I$178"), False, False, False, False, , False
        dest.Range("B160").FormulaR1C1 = "=Données!R[-156]C[9]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$L$5:$L$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$180:$I$198"), False, False, False, False, , False
        dest.Range("B180").FormulaR1C1 = "=Données!R[-176]C[10]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$M$5:$M$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$200:$I$218"), False, False, False, False, , False
        dest.Range("B200").FormulaR1C1 = "=Données!R[-196]C[11]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$N$65:$N$" & dernlig), _
        source.Range("$B$65:$B$" & dernlig), False, False, , dest.Range("$A$220:$I$238"), False, False, False, False, , False
        dest.Range("B220").FormulaR1C1 = "=Données!R[-216]C[12]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$O$65:$O$" & dernlig), _
        source.Range("$B$65:$B$" & dernlig), False, False, , dest.Range("$A$240:$I$258"), False, False, False, False, , False
        dest.Range("B240").FormulaR1C1 = "=Données!R[-236]C[13]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$P$173:$P$" & dernlig), _
        source.Range("$B$173:$B$" & dernlig), False, False, , dest.Range("$A$260:$I$278"), False, False, False, False, , False
        dest.Range("B260").FormulaR1C1 = "=Données!R[-256]C[14]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$Q$65:$Q$" & dernlig), _
        source.Range("$B$65:$B$" & dernlig), False, False, , dest.Range("$A$280:$I$298"), False, False, False, False, , False
        dest.Range("B280").FormulaR1C1 = "=Données!R[-276]C[15]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$R$5:$R$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$300:$I$318"), False, False, False, False, , False
        dest.Range("B300").FormulaR1C1 = "=Données!R[-296]C[16]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$S$5:$S$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$320:$I$338"), False, False, False, False, , False
        dest.Range("B320").FormulaR1C1 = "=Données!R[-316]C[17]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$T$65:$T$" & dernlig), _
        source.Range("$B$65:$B$" & dernlig), False, False, , dest.Range("$A$340:$I$358"), False, False, False, False, , False
        dest.Range("B340").FormulaR1C1 = "=Données!R[-336]C[18]"
 
    Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$U$5:$U$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$360:$I$378"), False, False, False, False, , False
        dest.Range("B360").FormulaR1C1 = "=Données!R[-356]C[19]"
End Sub

Ce code marche, mais je souhaiterais l'optimiser car je répète 18 fois la même action ...

Je pense avoir trouvé comment passer d'une colonne à l'autre automatiquement.

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
Option Explicit
Sub Calcul_régression()
'
' Calcul_régression Macro
'Suprime les données et les bordures des précédentes regressions
'Sélectionne l'ensemble des données non vides d'une colonne
'Calcule l'ensemble des régressions des différents secteurs et enregistre les données dans la feuille "regression taux longs"
'Copie le nom du secteur correspondant à la regession dans la feuille "données" et le colle en face de la cellule "Rapport détaillé" de la feuille Reg_taux_longs
 
Dim dest As Worksheet
Dim source As Worksheet
Dim dernlig As Long
Dim derncol As String
Dim T
Dim a$
a$ = Range("C1").SpecialCells(xlCellTypeLastCell).Address
T = Split(a$, "$", -1)
derncol = T(1)
 
Set dest = ThisWorkbook.Sheets("Reg_taux_longs")
Set source = ThisWorkbook.Sheets("Données")
dernlig = source.Range("C" & Rows.Count).End(xlUp).Row
derncol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
dest.Cells.ClearContents
dest.Cells.Borders(xlDiagonalDown).LineStyle = xlNone
dest.Cells.Borders(xlDiagonalUp).LineStyle = xlNone
dest.Cells.Borders(xlEdgeLeft).LineStyle = xlNone
dest.Cells.Borders(xlEdgeTop).LineStyle = xlNone
dest.Cells.Borders(xlEdgeBottom).LineStyle = xlNone
dest.Cells.Borders(xlEdgeRight).LineStyle = xlNone
dest.Cells.Borders(xlInsideVertical).LineStyle = xlNone
dest.Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
 
For i = C To derncol
     Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$i$5:$i$" & dernlig), _
        source.Range("$B$5:$B$" & dernlig), False, False, , dest.Range("$A$1:$G$18"), False, False, False, False, , False
        dest.Range("B1").FormulaR1C1 = "=Données!R[3]C[1]"
 
Next
        End Sub

Seulement, j'ai trois problématiques:
- La variable à expliquer i (pour rappel il y en a 18) commence soit à la ligne 5 et soit à la ligne 65 ou 173, comment faire commencer la régression à partir de la première cellule non vide de i. Par exemple, lorsqu'une variable à expliquer i commence à la ligne 65, la variable à expliquer sera source.Range("$B$65:$B$" & dernlig)

- Si le résultat de la première régression doit bien être stocké dans ("$A$1:$G$18"), je souhaiterais stocker les autres résultats dans des plages de 18 lignes et 7 colonnes automatiquement et espacer ces plages avec 1 ligne vide

- Ensuite, je copie colle le nom de la régression (qui est l'entête de la colonne i) à la 1ere ligne et deuxième colonne de la dite plage

Quelqu'un saurait-il comment faire une ou plusieurs de ces opération?

Merci d'avance!

**Menhir** · 13/07/2018, 15h37

Il y a de très nombreuses erreurs et incohérences dans ton second code.

Essaye ça :

Code :

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

1
2
3
4
5
6
7
Dim Cur As Range
 
For Each Cur In Range("C5:U5")
     Application.Run "ATPVBAEN.XLAM!Regress", Cur.Resize(dernlig - 5, 1), Cur.Offset(0, -1).Resize(dernlig - 5, 1) _
        , False, False, , dest.Range("A260:I278").Offset(Cur.Column * 20, 0), False, False, False, False, , False
        dest.Range("B260").Offset(Cur.Column * 20, 0).FormulaR1C1 = "=Données!R[" & (256 + Cur.Column * 20) & "]C[" & (Cur.Column + 14) & "]"
Next Cur

**vbondoma** · 16/07/2018, 12h10

Bonjour Menhir,

Merci beaucoup pour ta réponse. J'ai lancé ton code et il me revient qu'une erreur est suvénu concernant la plage d'entrée...

Aussi je ne comprends pas très bien les commandes offet et resize, tu pourrais m'éclairer?

J'ai également corriger les erreurs de mon précédent code qui ressemble désormais à ceci:

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
Option Explicit
Sub Calcul_régression()
'
' Calcul_régression Macro
'Suprime les données et les bordures des précédentes regressions
'Sélectionne l'ensemble des données non vides d'une colonne
'Calcule l'ensemble des régressions des différents secteurs et enregistre les données dans la feuille "regression taux longs"
'Copie le nom du secteur correspondant à la regession dans la feuille "données" et le colle en face de la cellule "Rapport détaillé" de la feuille Reg_taux_longs
 
Application.ScreenUpdating = False 'Désactive l'affichage le temps d'exécuter la macro
Application.Calculation = xlCalculationManual 'Désactive le recalcul automatique des formules Excel à chaque modification
 
Dim dest As Worksheet
Dim source As Worksheet
Dim premlig As Long, dernlig As Long, derncol As Long
Dim i
 
'bloc qui efface les précédents résultats et mises en forme
Set dest = ThisWorkbook.Sheets("Reg_taux_longs")
Set source = ThisWorkbook.Sheets("Données")
dernlig = source.Range("C" & Rows.Count).End(xlUp).Row 'la longueur des séries est variables
derncol = source.Cells(1, Cells.Columns.Count).End(xlToLeft).Column 'le nombre de variables explicatives et à expliquer peut varier
With dest.Cells
     .ClearContents
     .ClearFormats
End With
 
' boucles qui effectue autant de régressions qu'il y a de variables à expliquer
For i = 3 To derncol
 
    premlig = Columns(i).Find("*", , , , xlByRows, xlNext).Row 'Donne le numéro de la première ligne non vide de la colonne i
   'premlig = source.Cells(5, i).End(xlDown).Row
    If premlig > 180 Then premlig = 5 'Cas où pas de cellule vide entre en-tête et 1ère donnée
 
     Application.Run "ATPVBAEN.XLAM!Regress", source.Range("$" & Chr(64 + i) & "$premlig:$" & Chr(64 + i) & "$" & dernlig), _
        source.Range("$B$" & premlig & ":$B$" & dernlig), False, False, , dest.Range("$A$1:$I$18"), False, False, False, False, , False
        dest.Range("B1").FormulaR1C1 = "=Données!R[3]C[1]"
Next
 
Fin:
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

Il ne me reste plus qu'à stocker les résultat dans une nouvelle plage de 18 lignes et 7 colonnes à chaque fois et à copier-coller le nom de la régression à chaque fois... Si tu as des idées...

Merci encore!