數(shù)據(jù)輸入控件：TextDataNum（數(shù)據(jù)組數(shù)輸入TextBox），TextFacNum（參數(shù)個數(shù)輸入TextBox），TextInput（實驗數(shù)據(jù)輸入中介TextBox），GridIn（實驗數(shù)據(jù)表格MSFlexGrid）；
結(jié)果輸出控件：LabTRV（回歸相關(guān)系數(shù)顯示Label），LabTEV（回歸總體方差顯示Label），GridOut（各參數(shù)回歸系數(shù)、標準誤差顯示表格MSFlexGrid）；
程序控制控件：ComCalcu（程序執(zhí)行按鈕CommandButton）；
其它控件從略。
二、操作步驟
操作步驟簡述如下：
1、引用Microsoft Excel類型庫
“工程”-“引用”-選擇“Microsoft Excel 8.0 Object Library”-“確定”
2、聲明顯式數(shù)據(jù)類型，創(chuàng)建新實例并獲取Excel的控制句柄
Dim ExcelObject As Excel.Application
Set ExcelObject = CreateObject( "Excel.Application ")
3、調(diào)用并顯示Excel
Excelobject.Visible = True
由于Excel啟動為不可見，在編程調(diào)試過程中，需要監(jiān)測之，完工后最好Rem。
4、將GridIn中的數(shù)據(jù)送入Excel
5、Excel對數(shù)據(jù)進行多元回歸
6、將Excel運算結(jié)果輸入GridOut，LabTRV 和LabTEV
7、最后交還Excel控制句柄
Set ExcelObject = Nothing
此方法也可直接控制其他大量應用軟件，可從你的Object Library略知一二。
三、操作程序
部分源程序代碼如下：
通用聲明
Dim DNum As Integer ' DNum數(shù)據(jù)組數(shù)
Dim FNum As Integer ' FNum參數(shù)個數(shù)
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 = " 實驗數(shù)據(jù) "
.Col = 1: .Text = " 測值Y "
For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next i
For i = 2 To .Cols - 1
.Col = i
.Text = " 參數(shù) X " & (i - 1)
Next i
For i = 1 To .Rows - 1
.Col = 0
.Row = i: .Text = " " & i
Next i
End With
End Sub
--DataInitial '隨機產(chǎn)生GridIn數(shù)據(jù)模塊
Sub DataInitial() '隨機產(chǎn)生表格數(shù)據(jù)
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
為方便程序調(diào)式，實驗數(shù)據(jù)采用隨機產(chǎn)生；也可自行修改/輸入，從略
--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 = " 系數(shù)Ai "
.Row = 2: .Col = 0: .Text = " 相關(guān)系數(shù) "
For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next i
.Row = 0
For i = 2 To .Cols - 1
.Col = i
.Text = " 參數(shù) 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處于等待狀態(tài)
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 ") '創(chuàng)建新實例
'Excelobject.Visible = True '顯示調(diào)用
ExcelObject.Workbooks.Add '添加新工作簿
Sb = "B " & Format$(DNum)
Sc = Chr$(65 + FNum) & Format$(DNum)
'表格數(shù)據(jù)送入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 "實驗數(shù)據(jù)有空缺，請補充完整。 ", 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 '定位回歸結(jié)果顯示單元格
For i = 1 To 2
Ip = Format$(i + DNum) 'i=1時在第Dnum+1行顯示系數(shù)，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) " '相關(guān)系數(shù)
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) " '總體方差
'顯示回歸結(jié)果至GridOut
With Me.GridOut
'顯示Const系數(shù)
.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
'顯示系數(shù)
.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
'顯示總體相關(guān)系數(shù)
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回歸結(jié)果“矩陣”（記為A()）與一般的思維相異，以三元回歸為例，A(1,1)和A(2,1)分別為X3的回歸系數(shù)和標準誤差，A(1,2)和A(2,2)對應X2，A(1,3)和A(2,3)對應X1，A(1,4)和A(2,4)對應常數(shù)項，A(3,1)代表回歸相關(guān)系數(shù)，A(3,1)代表回歸總體方差。
本站僅提供存儲服務，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請
點擊舉報。
