用VB6控制Excel处理数据
; (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:$Acontentquot;& Format$(DNum)
& ",$B$1:contentquot; & Chr$(65 + FNum) & "contentquot; & 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:$Acontentquot; & Format$(DNum) & ",$B$1:contentquot; & Chr$(65 + FNum) & "contentquot; & Format$(DNum) & ",1,1),3,1)" ''相关系数
P = "B" & Format$(DNum + 3) ''定位
ExcelObject.Range(P).Formula = "=INDEX(LINEST($A$1:$Acontentquot; & Format$(DNum) & ",$B$1:contentquot; & Chr$(65 + FNum) & "contentquot; & 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" &am
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:$Acontentquot;& Format$(DNum)
& ",$B$1:contentquot; & Chr$(65 + FNum) & "contentquot; & 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:$Acontentquot; & Format$(DNum) & ",$B$1:contentquot; & Chr$(65 + FNum) & "contentquot; & Format$(DNum) & ",1,1),3,1)" ''相关系数
P = "B" & Format$(DNum + 3) ''定位
ExcelObject.Range(P).Formula = "=INDEX(LINEST($A$1:$Acontentquot; & Format$(DNum) & ",$B$1:contentquot; & Chr$(65 + FNum) & "contentquot; & 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" &am