用VB6控制Excel处理数据(2)

作者：佚名来源：chinavb.net 整理日期：2006-07-02

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调试通过。

[1] [2]