这是几个月以前我用Excel VBA进行的几个编程练习 ， 涉及到字符串处理 ， 计算 ， 用户界面控制 ， 以及基本的统计学知识 。 主要是3个案例 ， 1是多元线性回归 ， 人输入公式 ， 要Excel自动读取并回归出权重值；2是蒙特卡洛模拟 ， 给定几个指标的概率分布 ， 让Excel自动测算任意次运行结果；3是美国城市距离测算 ， 重点在搜索算法应用 ， 以及VBA从网页爬取信息（但是爬虫还是Python方便啊真的哈哈） 。
不说废话 ， 这篇文章讲第一个案例 ， Excel中怎么识别任意种回归公式？
其实类似于操作Eviews时在控制行输入公式的做法 。
目标：
文章插图
【ExcelVBA编程实现多元线性回归】首先是这样的用户页面
约定：A列x值 ， B列y值 ， VBA将根据位置读取数据；给出f1-f4四项 ， 可以输入任意符合“与x相关的数学表达”规则的公式 ， 例如图中给出了平方 ， 分数 ， 对数运算 ， 加减更不在话下 。
编程重点：首先页面实现 ， 打开开发工具创建即可 ， 其次公式识别 ， 字符串处理 ， 最后权重回归 ， 弹窗返回 。 同时要有拖动滑块选定任意行数据的功能 。
文章插图
D到G列输出各项值并弹窗返回回归结果
同时VBA应计算出这次回归的统计指标 ， 例如R值 ， 并且将回归曲线作图返回 。 R值在作图之前弹窗提示 。
文章插图
回归线作图
代码：
Option ExplicitOption Base 1Private Sub GoButton_Click()Dim tWB As Workbook, ypre As StringDim UserXRange As Range, UserYRange As RangeDim i As Integer, j As Integer, Ans As Integer, addx As String, addy As String, numx As Integer, numy As IntegerDim x As Variant, y As Variant, nterm As Integer, xtx As Variant, xtxi, xty As Variant, xt As VariantActiveWorkbook.Sheets(1).Range("C1:G20").ClearSet tWB = ThisWorkbooktWB.Activatenterm = 0If UserForm1.fxn1.Text <> "" Thennterm = nterm + 1If Not InStr(UserForm1.fxn1.Text, "x") > 0 ThenMsgBox "Input expression with x."Unload UserForm1UserForm1.ShowEnd IfEnd IfIf UserForm1.fxn2.Text <> "" Thennterm = nterm + 1If Not InStr(UserForm1.fxn1.Text, "x") > 0 ThenMsgBox "Input expression with x."Unload UserForm1UserForm1.ShowEnd IfEnd IfIf UserForm1.fxn3.Text <> "" Thennterm = nterm + 1If Not InStr(UserForm1.fxn1.Text, "x") > 0 ThenMsgBox "Input expression with x."Unload UserForm1UserForm1.ShowEnd IfEnd IfIf UserForm1.fxn4.Text <> "" Thennterm = nterm + 1If Not InStr(UserForm1.fxn1.Text, "x") > 0 ThenMsgBox "Input expression with x."Unload UserForm1UserForm1.ShowEnd IfEnd IfSet UserXRange = Application.InputBox("X Input Range", "X Input", "Sheet1!$A$1:$A$10", Type:=8)Set UserYRange = Application.InputBox("Y Input Range", "Y Input", "Sheet1!$B$1:$B$10", Type:=8)numx = UserXRange.Rows.Countnumy = UserYRange.Rows.CountIf nterm = 0 ThenMsgBox "You must input at least one term of X"Exit SubEnd IfIf numx <> numy ThenMsgBox "The number of X data and Y data is not equal, reset."Exit SubEnd IfIf numx < nterm + 2 ThenMsgBox "You must input more X-Y data (At least Number of Function+2)."Exit SubEnd Ifaddx = UserXRange.Addressaddy = UserYRange.AddressActiveWorkbook.Names.add Name:="x", RefersToR1C1:=ActiveWorkbook.Sheets(1).Range(addx)ActiveWorkbook.Names.add Name:="Y", RefersToR1C1:=ActiveWorkbook.Sheets(1).Range(addy)Dim beta As Variant, yp As VariantReDim beta(nterm + 1, 1) As Variant, yp(numx, 1) As VariantIf nterm = 1 ThenReDim x(numx, 2) As Variant, y(numx, 1) As VariantFor i = 1 To numxx(i, 1) = 1If UserForm1.fxn1.Text