ExcelVBA一键生成智能散点趋势图

代码功能概述

该VBA宏用于在Excel中自动创建带趋势线的散点图，支持多种多项式趋势线类型（1-5次函数），并显示方程和R²值。

1.主要功能模块

1.1 数据选择与验证

• 通过输入框让用户选择数据区域（要求至少2列，第一列为x值，第二列为y值）
• 检查数据有效性（如取消操作或数据不足时提示用户）

1.2 趋势线类型选择

• 提供5种趋势线选项（线性、二次至五次多项式）
• 默认使用线性趋势线，输入无效时自动回退

1.3 图表创建与配置

• 删除同名旧图表避免冲突
• 创建散点图并设置标题
• 自动将用户选择的数据绑定到图表

1.4 趋势线添加与样式设置

• 根据用户选择添加对应类型的趋势线（线性或多项式）
• 显示趋势线方程和R²值（决定系数）
• 设置趋势线为红色以增强可视性

兼容性处理

• 支持Excel 2007以上及早期版本的API差异（如颜色设置方式）

2.关键特性说明

• R²值：显示数据与趋势线的拟合程度（0-1，越接近1表示拟合越好）
• 多项式拟合：避免使用泰勒公式等复杂方法，因高次多项式易导致过拟合
• 交互友好：通过输入框引导用户操作，错误处理完善

3.输出结果

最终生成一个包含散点图、趋势线、方程和R²值的图表，位置紧邻原始数据右侧。

视频演示：

                                                                      视频演示1

                                                                      视频演示2

代码展示：

Attribute VB_Name = "Scatter"
Sub AutoAddScatterWithTrendline()Dim ws As WorksheetDim rngData As RangeDim chartObj As ChartObjectDim myChart As ChartDim seriesCol As SeriesCollectionDim trendlineObj As ObjectDim trendType As Long ' 趋势线类型变量' 选择数据范围Set ws = ActiveSheetOn Error Resume NextSet rngData = Application.InputBox( _Prompt:="请选择数据区域（第一列x，第二列y）", _Title:="选择数据", _Type:=8)On Error GoTo 0' 检查用户是否取消选择If rngData Is Nothing ThenMsgBox "操作已取消", vbInformationExit SubEnd If' 检查数据是否有效If rngData.Rows.Count < 2 Or rngData.Columns.Count < 2 ThenMsgBox "请选择至少2行2列的有效数据", vbCriticalExit SubEnd If' 让用户选择趋势线类型trendType = Application.InputBox( _Prompt:="请选择趋势线类型:" & vbCrLf & _"1 - 线性 (一次函数)" & vbCrLf & _"2 - 二次函数" & vbCrLf & _"3 - 三次函数" & vbCrLf & _"4 - 四次函数" & vbCrLf & _"5 - 五次函数", _Title:="选择趋势线类型", _Type:=1, Default:=1)' 检查用户是否取消或输入无效If trendType < 1 Or trendType > 5 ThenMsgBox "无效的选择，将使用默认的线性趋势线", vbInformationtrendType = 1End If' 删除可能存在的旧图表On Error Resume Nextws.ChartObjects("DataTrendChart").DeleteOn Error GoTo 0' 创建新图表Set chartObj = ws.ChartObjects.Add( _Left:=rngData.Left + rngData.Width + 20, _Top:=rngData.Top, _Width:=500, _Height:=300)chartObj.Name = "DataTrendChart"Set myChart = chartObj.Chart' 配置图表数据myChart.ChartType = xlXYScattermyChart.SetSourceData Source:=rngDatamyChart.HasTitle = TruemyChart.ChartTitle.Text = "数据趋势分析"
' R2（决定系数）：衡量数据与趋势线（或回归模型）贴合程度的指标，取值 0-1。
' 越接近 1，数据越贴近趋势线，模型能解释更多数据变化（如 R2=0.8 即 80% 因变量变化可由自变量解释）；
' 越接近 0，数据越分散，模型解释力越差。' 不用泰勒公式拟合的原因：泰勒公式需用高次多项式，不仅模型复杂、难解释实际意义，
' 还对数据波动敏感，易出现 “过度拟合”（贴合现有数据却偏离真实趋势）；
' 而趋势线的核心是抓数据整体规律，泰勒公式适用场景极窄，远不如直线等简单模型实用。' 确保系列集合存在On Error Resume NextSet seriesCol = myChart.SeriesCollectionIf Err.Number <> 0 ThenMsgBox "无法创建数据系列: " & Err.Description, vbCriticalchartObj.DeleteExit SubEnd IfOn Error GoTo 0' 确保至少有一个数据系列If seriesCol.Count = 0 ThenMsgBox "未检测到有效数据系列", vbCriticalchartObj.DeleteExit SubEnd If' 兼容方式添加趋势线On Error Resume Next' 先删除可能存在的旧趋势线Do While seriesCol(1).Trendlines.Count > 0seriesCol(1).Trendlines(1).DeleteLoop' 根据用户选择添加不同类型的趋势线Select Case trendTypeCase 1 ' 线性Set trendlineObj = seriesCol(1).Trendlines.Add(Type:=xlLinear)Case 2 ' 二次函数Set trendlineObj = seriesCol(1).Trendlines.Add(Type:=xlPolynomial, Order:=2)Case 3 ' 三次函数Set trendlineObj = seriesCol(1).Trendlines.Add(Type:=xlPolynomial, Order:=3)Case 4 ' 四次函数Set trendlineObj = seriesCol(1).Trendlines.Add(Type:=xlPolynomial, Order:=4)Case 5 ' 五次函数Set trendlineObj = seriesCol(1).Trendlines.Add(Type:=xlPolynomial, Order:=5)End SelectIf Err.Number <> 0 ThenMsgBox "添加趋势线失败: " & Err.Description, vbCriticalchartObj.DeleteExit SubEnd IfOn Error GoTo 0' 配置趋势线属性With trendlineObj.DisplayEquation = True.DisplayRSquared = True' 设置趋势线颜色If Val(Application.Version) >= 12 Then ' Excel 2007及以上.Format.Line.ForeColor.RGB = RGB(255, 0, 0)Else ' 早期版本.Line.Color = RGB(255, 0, 0)End IfEnd WithMsgBox "图表生成成功！趋势线方程已显示。", vbInformation
End Sub