Comment appliquer la fonction LinEst aux lignes ?

Question

J'utilise la fonction WorksheetFunction.LinEst pour effectuer une régression quadratique depuis des années sans aucun problème. Mes données ont toujours été stockées en colonnes dans la feuille de calcul Excel.

Maintenant, on m'envoie des données en lignes, plutôt qu'en colonnes. Mes appels à WorksheetFunction.LinEst échouent.
Si je traite la même commande comme une formule dans la feuille de travail, cela fonctionne.

Je n'ai pas la possibilité de transposer les données. J'utilise les versions les plus récentes de Windows 10 et de Microsoft Office 365.

Je n'ai pas trouvé ici d'exemples écrits en VBA où les données sont stockées en lignes.

Voici une copie propre de la sous-routine que j'appelle pour effectuer la régression. J'ai enlevé tout le code de débogage, pour le rendre plus lisible.
La version complète est plus bas.
Après ce code, il y a un code que j'ai écrit pour démontrer l'échec.

Sub GetPolynomialRegressionCoefficients(Xs As Excel.Range, Ys As Excel.Range, ByRef x1 As Double, ByRef x2 As Double, ByRef x3 As Double)
    '
    ' Calculates the best fit cooeficients of the the data stored in ranges Xs and Ys
    '
    Dim rgCoeff  ' This will be a variant array of the coefficients calculated for the best fit quadratic curve

    rgCoeff = Application.WorksheetFunction.LinEst(Ys, Application.Power(Xs, Array(1, 2)))

    x1 = rgCoeff(1)
    x2 = rgCoeff(2)
    x3 = rgCoeff(3)
End Sub

Le code suivant crée un jeu de données simple pour calculer les coefficients de la fonction y = x^2. En utilisant les mêmes données, d'abord stockées en colonnes, puis stockées en lignes, mon code fonctionne avec les données en colonnes, mais échoue avec les données en lignes.

Sub TestGetPolynomialRegressionCoefficients()
    Dim rXs As Excel.Range  ' Range for the X values
    Dim rYs As Excel.Range  ' Range for the Y values
    Dim ws As Excel.Worksheet
    Dim iRow As Long
    Dim iCol As Long
    Dim x As Long
    Dim x1 As Double
    Dim x2 As Double
    Dim x3 As Double

    Set ws = ThisWorkbook.Worksheets("LinEstTest")
    '
    ' Works! - Test data y = x^2 with data in columns
    '
    ws.Cells.Clear
    For x = 0 To 9
        iRow = x + 1
        ws.Cells(iRow, 1) = x         ' these will be the domain (the Xs)
        ws.Cells(iRow, 2) = x * x     ' these will be the range (the Ys)
    Next x

    Set rXs = ws.Range(ws.Cells(1, 1), ws.Cells(10, 1))
    Set rYs = ws.Range(ws.Cells(1, 2), ws.Cells(10, 2))

    On Error Resume Next
    x1 = -1: x2 = -1: x3 = -1
    GetPolynomialRegressionCoefficients rXs, rYs, x1, x2, x3
    If Err <> 0 Then
        Debug.Print "Error using Columns "; Err; " "; Err.Description
    Else
        Debug.Print "With data in columns, x1 = "; x1; ", x2 = "; x2; ", x3 = "; x3
    End If
    '
    ' Fails! - Test data y = x^2 with data in rows
    '
    ws.Cells.Clear
    For x = 0 To 9
        iCol = x + 1
        ws.Cells(1, iCol) = x         ' these will be the domain (the Xs)
        ws.Cells(2, iCol) = x * x     ' these will be the range (the Ys)
    Next x

    Set rXs = ws.Range(ws.Cells(1, 1), ws.Cells(1, 10))
    Set rYs = ws.Range(ws.Cells(2, 1), ws.Cells(2, 10))

    On Error Resume Next
    x1 = -1: x2 = -1: x3 = -1
    GetPolynomialRegressionCoefficients rXs, rYs, x1, x2, x3
    '
    ' Get Error message dialog:
    '
    ' Microsoft Visual Basic
    ' Run-time error '1004':
    ' Unable to get the LinEst property of the WorksheetFunction class
    '
    If Err <> 0 Then
        Debug.Print "Error Using Rows "; Err; " "; Err.Description
    Else
        Debug.Print "With data in rows, x1 = "; x1; ", x2 = "; x2; ", x3 = "; x3
    End If
End Sub

Voici le résultat que j'obtiens dans ma fenêtre immédiate lorsque j'exécute le code de test :

With data in columns, x1 =  1 , x2 =  0 , x3 =  0 
Error Using Rows  1004  Unable to get the LinEst property of the WorksheetFunction class

Enfin, voici la version complète de ma routine avec le code de débogage et de validation. Fournie à titre de référence uniquement (merci de ne pas la critiquer) :

Sub GetPolynomialRegressionCoefficients(Xs As Excel.Range, Ys As Excel.Range, ByRef x1 As Double, ByRef x2 As Double, ByRef x3 As Double)
    '
    ' Calculates the best fit cooeficients of the the data stored in ranges Xs and Ys
    '
    Dim rgCoeff  ' This will be a variant array of the coefficients calculated for the best fit quadratic curve
#If RELEASE = 0 Then
    Dim iRow As Long  ' Used only for debugging purposes.
    Dim iCol As Long  ' Used only for debugging purposes.
    '
    ' Confirm that the ranges are the same size.
    '
    If (Xs.Rows.Count <> Ys.Rows.Count) And (Xs.Columns.Count <> Ys.Columns.Count) Then Stop
    '
    ' Confirm that all the data in the ranges is numeric and not blank
    '
    For iRow = 1 To Ys.Rows.Count
        For iCol = 1 To Xs.Columns.Count
            If IsNumeric(Xs.Cells(iRow, iCol)) = False Or IsNumeric(Ys.Cells(iRow, iCol)) = False Or Trim(Xs.Cells(iRow, iCol)) = "" Or Trim(Ys.Cells(iRow, iCol)) = "" Then Stop
        Next iCol
    Next iRow

    DoEvents
#End If

    rgCoeff = Application.WorksheetFunction.LinEst(Ys, Application.Power(Xs, Array(1, 2)))

    x1 = rgCoeff(1)
    x2 = rgCoeff(2)
    x3 = rgCoeff(3)

End Sub

Answer 1

TLDR : Pour les données en lignes, vous devez utiliser la fonction Array(Array(1), Array(2)) au lieu de Array(1, 2)

---

Le problème n'est pas le WorksheetFunction.LinEst mais la fonction Application.Power fonction. Pour vérifier cela, vous pouvez ajouter une variable intermédiaire appelée XsArray comme ceci :

Sub GetPolynomialRegressionCoefficients(Xs As Excel.Range, Ys As Excel.Range, ByRef x1 As Double, ByRef x2 As Double, ByRef x3 As Double)
    '
    ' Calculates the best fit coefficients of the data stored in ranges Xs and Ys
    '
    Dim rgCoeff  ' This will be a variant array of the coefficients calculated for the best fit quadratic curve

    Dim XsArray As Variant
    XsArray = Application.Power(Xs, Array(1, 2))

    rgCoeff = Application.WorksheetFunction.LinEst(Ys, XsArray)

    x1 = rgCoeff(1)
    x2 = rgCoeff(2)
    x3 = rgCoeff(3)
End Sub

Et si vous ouvrez la fenêtre locale (après avoir placé un point d'arrêt), vous verrez que c'est de là que provient l'erreur :

Je n'ai pas trouvé de bonnes explications à ce sujet, mais si je comprends bien, la fonction Puissance fonctionne un peu comme une multiplication matricielle : vous voulez avoir une matrice ligne multipliant une matrice colonne ou vice-versa, vous ne voulez pas deux matrices ligne ou deux matrices colonne.

Le truc ici c'est que Array(1,2) est considéré par VBA comme une matrice de lignes puisqu'il s'agit d'un simple tableau 1D. Ainsi, tout va bien lorsque Xs est une "plage de colonnes", mais lorsqu'il s'agit d'une "plage de lignes", nous devons passer quelque chose qui sera vu comme une matrice de colonnes. Une façon d'y parvenir serait la suivante :

Sub GetPolynomialRegressionCoefficients(Xs As Excel.Range, Ys As Excel.Range, ByRef x1 As Double, ByRef x2 As Double, ByRef x3 As Double)
    '
    ' Calculates the best fit coefficients of the data stored in ranges Xs and Ys
    '
    Dim rgCoeff  ' This will be a variant array of the coefficients calculated for the best fit quadratic curve

    Dim XsArray As Variant
    If Xs.Rows.Count > Xs.Columns.Count Then
        XsArray = Application.Power(Xs, Array(1, 2))
    Else
        XsArray = Application.Power(Xs, Array(Array(1), Array(2)))
    End If

    rgCoeff = Application.WorksheetFunction.LinEst(Ys, XsArray)

    x1 = rgCoeff(1)
    x2 = rgCoeff(2)
    x3 = rgCoeff(3)
End Sub

Explication

L'expression Array(Array(1), Array(2)) renvoie un tableau en dents de scie mais, d'après ce que j'ai compris, comme il faut 2 index pour renvoyer un élément, VBA l'interprétera de la même manière qu'un tableau 2D et ces index seront considérés comme les coordonnées d'une matrice (colonne) : (0,0) et (1,0).

Ou bien

Si vous n'aimez pas les tableaux en dents de scie, vous pouvez toujours créer un vrai tableau 2D avec une boucle :

Dim XsArray As Variant, PowersArray As Variant

If Xs.Rows.Count > Xs.Columns.Count Then
    PowersArray = Array(1, 2)
    XsArray = Application.Power(Xs, PowersArray)
Else
    ReDim PowersArray(0 To 1, 0)
    Dim i As Integer
    For i = 0 To 1
        PowersArray(i, 0) = i + 1
    Next i
    XsArray = Application.Power(Xs, PowersArray)
End If