Plusieurs Régressions avec des plages variables

Fermé
vbondoma Messages postés 4 Date d'inscription vendredi 13 juillet 2018 Statut Membre Dernière intervention 16 juillet 2018 - 13 juil. 2018 à 14:45
yg_be Messages postés 23268 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 22 octobre 2024 - 16 juil. 2018 à 13:18


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).

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

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.

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érations?

Merci d'avance!

3 réponses

ccm81 Messages postés 10898 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 octobre 2024 2 422
Modifié le 14 juil. 2018 à 21:02
Bonjour

1. ici, tu peux faire plus simple
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
à remplacer par
dest.Cells.ClearFormat

2.
i=2
Première ligne non vide de la colonne i
lideb = Columns(i).Find("*", , , , xlByRows, xlNext).Row

Dernière ligne non vide de la colonne i
lifin = Columns(i).Find("*", , , , xlByRows, xlPrevious).Row

adresse de la plage colonne i depuis lideb jusqu'à lifin
adr= Range(Cells(lideb, i), Cells(lifin, i)).Address


RQ. Si ton code fonctionne comme tu le souhaites, pourquoi vouloir le changer, le fait de faire replacer les 18 bouts de code par une boucle entraine des calculs supplémentaires donc du temps de traitement en plus.

Cdlmnt
1
ccm81 Messages postés 10898 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 octobre 2024 2 422
Modifié le 15 juil. 2018 à 22:34
Petite modif.... ajouter un "s" à ClearFormat
dest.Cells.ClearFormats

salut à yg_be en passant

Cdlmnt
0
vbondoma Messages postés 4 Date d'inscription vendredi 13 juillet 2018 Statut Membre Dernière intervention 16 juillet 2018 > ccm81 Messages postés 10898 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 octobre 2024
16 juil. 2018 à 10:19
Merci pour ces commandes précieuses!

En réalité les destinataire de ce travail ne savent pas du tout coder. Le but est donc de leur livrer une macro clé en main qu'il auront juste à faire tourner quelque soit le nombre de variables expliquées ou explicatives et quelque soit le longueur des séries...
0
yg_be Messages postés 23268 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 22 octobre 2024 Ambassadeur 1 544
Modifié le 15 juil. 2018 à 17:19
bonjour,
mieux de déclarer
Dim derncol As long

as-tu déclaré i?
aussi, au lieu de
"$i$5:$i$"
, je suggère:
cstr(i) & "5:" & cstr(i)

et
For i = 3 To derncol
1
vbondoma Messages postés 4 Date d'inscription vendredi 13 juillet 2018 Statut Membre Dernière intervention 16 juillet 2018
16 juil. 2018 à 10:44
Bonjour et merci pour ta réponse,

Je ne suis pas sûre de ce que fait cstr(i), j'ai essayer Chr(64 + i) pour avoir la lettre d'une cellule.

Sur vos conseils et après des recherches internet le code est désormais sous cette forme :

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

'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

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ésultats dans une nouvelle plage de 18 lignes et 7 colonnes à chaque fois et à copier le nom de chaque régression... Si vous avez des idées...
0
vbondoma Messages postés 4 Date d'inscription vendredi 13 juillet 2018 Statut Membre Dernière intervention 16 juillet 2018
16 juil. 2018 à 11:48
Je pense avoir trouvé comment faire...

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 As Long

On Error GoTo Fin

'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 'Donne le numéro de la première ligne non vide de la colonne i
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("A260:I278").Offset(i * 20, 0), False, False, False, False, , False
dest.Range("B260").Offset(i * 20, 0).FormulaR1C1 = "=Données!R[" & (256 + i * 20) & "]C[" & (i + 14) & "]"
Next i

Fin:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub




Mais lorsque je lance la macro, elle ne me renvoie ni résultat, ni message d'erreur... Quelqu'un saurait ce que je fais mal?
0
yg_be Messages postés 23268 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 22 octobre 2024 1 544
16 juil. 2018 à 13:18
si tu veux voir les erreurs, supprime la ligne avec "on error".
0