如何优化Excel VBA代码实现控制点间的多项式回归曲线拟合？

问题背景 #

我正尝试编写VBA代码，在控制点间绘制平滑曲线（示例曲线如下）：

现有一段基于LINEST函数的多项式回归代码，但无法正常运行，需要指导修正以实现曲线拟合。

原始代码 #

Public Sub TestLinest()

Dim x
Dim i As Long
Dim evalString As String
Dim sheetDisplayName As String
Dim polyOrder As String

' this is whatever the name of your sheet containing data:
sheetDisplayName = "Sheet1"
' this gets the index of the last cell in the data range
i = Range(sheetDisplayName & "!A17").End(xlDown).Row
' Obviously change this depending on how many polynomial terms you need
polyOrder = "{1,2,3}"

evalString = "=linest(" & sheetDisplayName & "!E6:E" & i & ", " & sheetDisplayName & "!D6:D" & i & "^" & polyOrder & ")"
x = Application.Evaluate(evalString)

Cells(3, 8) = x(1)
Cells(4, 8) = x(2)
Cells(5, 8) = x(3)
Cells(6, 8) = x(4)

End Sub

代码问题分析与修正方案 #

• 数据范围获取逻辑错误
  原始代码通过A17向下查找最后一行，若A17下方无数据会直接跳到工作表末尾，导致数据范围错误。建议改为从自变量/因变量列的起始数据行查找：

  i = Sheets(sheetDisplayName).Range("D6").End(xlDown).Row
  

• LINEST函数参数格式错误
  Excel的LINEST处理多项式回归时，自变量部分的格式需要被正确解析，原始写法无法生成有效的多项式自变量矩阵。调整为以下格式：

  evalString = "=LINEST(" & sheetDisplayName & "!E6:E" & i & ", " & _
               "(" & sheetDisplayName & "!D6:D" & i & ")^" & polyOrder & ", TRUE, TRUE)"
  

  其中TRUE, TRUE分别表示计算截距、返回附加统计信息（可选，用于调试）。

• 结果输出安全性处理
  LINEST返回二维数组，直接赋值可能因维度不匹配报错，需先判断数组有效性：

  If Not IsError(x) Then
      Cells(3, 8).Resize(UBound(x, 1), UBound(x, 2)).Value = x
  Else
      MsgBox "拟合失败，请检查数据范围！"
  End If
  

修正后的完整代码 #

Public Sub TestLinest()
    Dim x As Variant
    Dim i As Long
    Dim evalString As String
    Dim sheetDisplayName As String
    Dim polyOrder As String

    ' 数据所在工作表名称
    sheetDisplayName = "Sheet1"
    ' 获取自变量D列的最后一行数据行号（从D6开始向下查找）
    i = Sheets(sheetDisplayName).Range("D6").End(xlDown).Row
    ' 多项式阶数，{1,2,3}表示3次多项式
    polyOrder = "{1,2,3}"

    ' 构造LINEST函数的计算公式
    evalString = "=LINEST(" & sheetDisplayName & "!E6:E" & i & ", " & _
                 "(" & sheetDisplayName & "!D6:D" & i & ")^" & polyOrder & ", TRUE, TRUE)"
    
    ' 执行函数计算
    x = Application.Evaluate(evalString)

    ' 输出拟合结果到H3开始的区域
    If Not IsError(x) Then
        Sheets(sheetDisplayName).Cells(3, 8).Resize(UBound(x, 1), UBound(x, 2)).Value = x
    Else
        MsgBox "拟合失败，请检查数据是否有效或范围是否正确！"
    End If
End Sub

后续绘图建议 #

得到多项式系数后，可按以下步骤绘制平滑曲线：

• 根据自变量范围生成足够多的插值点（如每隔0.1取一个点）
• 用拟合的多项式公式计算每个插值点的因变量值
• 将插值点数据插入工作表，插入散点图并选择平滑曲线样式

内容的提问来源于stack exchange，提问作者K4ever