excel - 如何将 LinEst 函数应用于行？

Question

多年来，我一直在使用 WorksheetFunction.LinEst 进行二次回归，没有出现任何问题。我的数据一直存储在 Excel 工作表的列中。
现在我按行而不是列发送数据。我对 WorksheetFunction.LinEst 的调用失败了。
如果我处理与工作表中的公式相同的命令，它就可以工作。
我没有转置数据的选项。我使用的是最新版本的 Windows 10 和 Microsoft Office 365。
我在这里找不到任何用 VBA 编写的将数据存储在行中的示例。
这是我调用以执行回归的子例程的干净副本。我删除了所有调试代码，使其更具可读性。
完整版在更远的地方。
在这段代码之后是我为演示失败而编写的一些代码。

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

下一个代码创建一个简单的数据集来计算 y = x^2 函数的系数。使用相同的数据，首先存储在列中，然后存储在行中，我的代码处理列中的数据，但无法处理行中的数据。

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

这是我在运行测试代码时在即时窗口中得到的输出:

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

最后，这是我的例程的完整版本，带有调试和验证代码。仅供引用(请勿批评):

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:对于行中的数据，您需要使用 Array(Array(1), Array(2))而不是 Array(1, 2)
问题不在于 WorksheetFunction.LinEst功能，但 Application.Power功能。要检查这一点，您可以添加一个名为 XsArray 的中间变量，如下所示:

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

如果您打开本地窗口(在放置断点之后)，您会看到这是错误的来源:

我找不到任何好的现有解释，但我理解它的方式是 Power 函数有点像矩阵乘法:你要么想要一个行矩阵乘以一个列矩阵，反之亦然，你不想要两个行矩阵或 2 个列矩阵。
这里的事情是 Array(1,2) VBA 将其视为行矩阵，因为它是一个简单的一维数组。所以，当 Xs 时，一切都很好。是一个“列范围”，但是当它是一个“行范围”时，我们需要传递一些将被视为列矩阵的东西。实现这一目标的一种方法是:

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

解释
表达式 Array(Array(1), Array(2))返回一个锯齿状数组，但据我了解，由于它需要 2 个索引来返回一个元素，VBA 会将其解释为 2D 数组，这些索引将被视为来自(列)矩阵的坐标:(0,0)和 (1,0)。

或者
如果你不喜欢锯齿状数组，你总是可以用循环创建一个真正的二维数组:

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