vb.txt

最小二乘法的vb源码 最小二乘法的vb源码 最小二乘法的vb源码

Public Function LineANA() As Boolean 

Dim StdNum As Integer '标准个数，需输入数据 
Dim StdX(10) As Single, StdY(10) As Single '假设多至10个标准数据，需一一输入数据 

Dim k As Single, r As Single, b As Single '计算结果的斜率，截距和线性相关系数 

Dim G1 As Single, G2 As Single, G3 As Single, G4 As Single 
Dim G5 As Single, L1 As Single, L2 As Single, L3 As Single 

Dim i As Integer 


On Error GoTo ErrHandler 
If StdNum = 1 Then 
k = StdY(1) / StdX(1) 'StdX(1)不能等于0 
r = 1 
b = 0 
If k <= 0 Then GoTo ErrHandler 
LineANA = True 
End If 
Exit Function 

For i = 1 To StdNum 
G1 = G1 + StdX(i) 
G2 = G2 + StdY(i) 
G3 = G3 + StdX(i) * StdY(i) 
G4 = G4 + StdX(i) ^ 2 
G5 = G5 + StdY(i) ^ 2 

Next 

L1 = G3 - G1 * G2 / StdNum 
L2 = G4 - G1 ^ 2 / StdNum 
L3 = G5 - G2 ^ 2 / StdNum 


r = L1 / Sqr(L2 * L3) 
k = L1 / L2 
b = (G2 - k * G1) / StdNum 

If k <= 0 Then GoTo ErrHandler 
LineANA = True 
Exit Function 

ErrHandler: 
MsgBox "拟合计算错误! ", vbCritical, gcstMsgBoxErrTitle 
LineANA = False