Excel是微软办公软件的“大腕”之一,几乎已经成为电子表格软件的代名词。除了管理数据并对其进行一些简单的数学运算外,Excel还拥有强大的数据处理功能,尤其是其中的数理统计功能,更是那些对SAS、SPSS望而生畏的“软脚蟹”们的最佳选择;但Excel并非真是如此那么简单,要随心所欲运用之并非易事,本大虾周围总有人被Excel的INDEX结果显示整得云里雾里(还有很多问题哦!)。最近本大虾潜入海底闭关修炼了一阵,试着打造“VB+Excel”,期望推出“傻瓜型”数据处理“小件”,已有所小成。现以调用Excel中的LINEST(多元线性回归函数)为例,和各位大虾煮酒论剑,望指正。
一、VB控制界面组成
数据输入控件:TextDataNum(数据组数输入TextBox),TextFacNum(参数个数输入TextBox),TextInput(实验数据输入中介TextBox),GridIn(实验数据表格MSFlexGrid);
结果输出控件:LabTRV(回归相关系数显示Label),LabTEV(回归总体方差显示Label),GridOut(各参数回归系数、标准误差显示表格MSFlexGrid);
程序控制控件:ComCalcu(程序执行按钮CommandButton);
其它控件从略。
二、操作步骤
操作步骤简述如下:
1、引用Microsoft Excel类型库
“工程”-“引用”-选择“Microsoft Excel 8.0 Object Library”-“确定”
2、声明显式数据类型,创建新实例并获取Excel的控制句柄
Dim ExcelObject As Excel.Application
Set ExcelObject = CreateObject("Excel.Application")
3、调用并显示Excel
Excelobject.Visible = True
由于Excel启动为不可见,在编程调试过程中,需要监测之,完工后最好Rem。
4、将GridIn中的数据送入Excel
5、Excel对数据进行多元回归
6、将Excel运算结果输入GridOut,LabTRV 和LabTEV
7、最后交还Excel控制句柄
Set ExcelObject = Nothing
此方法也可直接控制其他大量应用软件,可从你的Object Library略知一二。
三、操作程序
部分源程序代码如下:
通用声明
Dim DNum As Integer ' DNum数据组数
Dim FNum As Integer ' FNum参数个数
Dim ExcelObject As Excel.Application
表格初始化
--DataGRidMK 'GridIn制作模块
Sub DataGRidMK()
DNum = Val(Me.TextDataNum.Text)
FNum = Val(Me.TextFacNum.Text)
With Me.GridIn
.Cols = FNum + 2
.Rows = DNum + 1
End With
With Me.GridIn
.Row = 0
.Col = 0: .Text = " 实验数据"
.Col = 1: .Text = " 测值Y"
For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next i
For i = 2 To .Cols - 1
.Col = i
.Text = " 参数 X" & (i - 1)
Next i
For i = 1 To .Rows - 1
.Col = 0
.Row = i: .Text = " " & i
Next i
End With
End Sub
--DataInitial '随机产生GridIn数据模块
Sub DataInitial() '随机产生表格数据
Randomize Timer
With Me.GridIn
For i = 1 To .Rows - 1
.Row = i
For j = 1 To .Cols - 1
.Col = j
.Text = Rnd * 500 \ 1
Next j
Next i
End With
End Sub
为方便程序调式,实验数据采用随机产生;也可自行修改/输入,从略
--GridOutMK 'GridOut制作模块
Sub GridOutMK()
With Me.GridOut
.Cols = FNum + 2
.Rows = 3
End With
With Me.GridOut
.Row = 0
.Col = 0: .Text = " 回归输出"
.Col = 1: .Text = " Const"
.Row = 1: .Col = 0: .Text = " 系数Ai"
.Row = 2: .Col = 0: .Text = " 相关系数"
For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next i
.Row = 0
For i = 2 To .Cols - 1
.Col = i
.Text = " 参数 X" & (i - 1)
Next i
End With
End Sub
回归运算
Private Sub ComCalcu_Click()
' GridOut清空
With Me.GridOut
For i = 1 To .Rows - 1
.Row = i
For j = 1 To .Cols - 1
.Col = j
.Text = ""
Next j
Next i
End With
'LabTEV,LabTRV处于等待状态
With Me.LabTEV
.BackColor = vbBlue
End With
With Me.LabTRV
.BackColor = vbBlue
End With
Dim SA As String, Sb$, Sc$
Set ExcelObject = CreateObject("Excel.Application") '创建新实例
'Excelobject.Visible = True '显示调用
ExcelObject.Workbooks.Add '添加新工作簿
Sb = "B" & Format$(DNum)
Sc = Chr$(65 + FNum) & Format$(DNum)
'表格数据送入Excel
For i = 1 To DNum
Me.GridIn.Row = i
For j = 1 To FNum + 1
Me.GridIn.Col = j
If Me.GridIn.Text = "" Then
MsgBox "实验数据有空缺,请补充完整。", vbOKOnly, "警告"
With Me.LabTEV
.Caption = "#VALUE"
.BackColor = &HC0C0C0
End With
With Me.LabTRV
.Caption = "#VALUE"
.BackColor = &HC0C0C0
End With
'Set Excelobject = Nothing
Exit Sub
End If
SA = Chr$(64 + j) & Format$(i)
ExcelObject.Range(SA).Value = Me.GridIn.Text
Next j
Next i
'回归运算
Dim Ip, P As String '定位回归结果显示单元格
For i = 1 To 2
Ip = Format$(i + DNum) 'i=1时在第Dnum+1行显示系数,i=2时在第Dnum+2行 显示标准误差
For j = 1 To FNum + 1
P = Chr$(64 + j) & Ip
ExcelObject.Range(P).Formula="=INDEX(LINEST($A$1:$A$"& Format$(DNum)
& ",$B$1:$" & Chr$(65 + FNum) & "$" & Format$(DNum) & ",1,1)," &
Format$(i) & "," & Format$(j) & ")"
Next j
Next i
P = "A" & Format$(DNum + 3) '定位
ExcelObject.Range(P).Formula = "=INDEX(LINEST($A$1:$A$" & Format$(DNum) & ",$B$1:$" & Chr$(65 + FNum) & "$" & Format$(DNum) & ",1,1),3,1)" '相关系数
P = "B" & Format$(DNum + 3) '定位
ExcelObject.Range(P).Formula = "=INDEX(LINEST($A$1:$A$" & Format$(DNum) & ",$B$1:$" & Chr$(65 + FNum) & "$" & Format$(DNum) & ",1,1),3,2)" '总体方差
'显示回归结果至GridOut
With Me.GridOut
'显示Const系数
.Row = 1: .Col = 1
P = Chr$(64 + FNum + 1) & Format$(DNum + 1)
.Text = Format$(ExcelObject.Range(P).Value, "0.0000")
'显示Const标准误差
.Row = 2: .Col = 1
P = Chr$(64 + FNum + 1) & Format$(DNum + 2)
.Text = Format$(ExcelObject.Range(P).Value, "0.0000")
For i = 1 To FNum
'显示系数
.Row = 1
P = Chr$(64 + i) & Format$(DNum + 1)
.Col = FNum - i + 2
.Text = Format$(ExcelObject.Range(P).Value, "0.0000")
'显示标准误差
.Row = 2
P = Chr$(64 + i) & Format$(DNum + 2)
.Col = FNum - i + 2
.Text = Format$(ExcelObject.Range(P).Value, "0.0000")
Next i
End With
'显示总体相关系数
P = "A" & Format$(DNum + 3)
Me.LabTRV.Caption = Format$(ExcelObject.Range(P).Value, "0.0000")
'显示总体方差
P = "B" & Format$(DNum + 3)
Me.LabTEV.Caption = Format$(ExcelObject.Range(P).Value, "0.0000")
With Me.LabTEV
.BackColor = &HC0C0C0
End With
With Me.LabTRV
.BackColor = &HC0C0C0
End With
Set ExcelObject = Nothing
End Sub
说明:Excel回归结果“矩阵”(记为A())与一般的思维相异,以三元回归为例,A(1,1)和A(2,1)分别为X3的回归系数和标准误差,A(1,2)和A(2,2)对应X2,A(1,3)和A(2,3)对应X1,A(1,4)和A(2,4)对应常数项,A(3,1)代表回归相关系数,A(3,1)代表回归总体方差。够狡猾的吧?!其他问题还多着呢。“大腕”们原来也是能懒则懒的(同是打工仔,呵呵)。
本程序在VB6.0调试通过。好了,本大虾就灌这点水。各位大虾请来信联系:panhouse@sohu.com
文章来源于领测软件测试网 https://www.ltesting.net/