Option Explicit
Private Sub Command1_Click()
Dim Qd(30) As Double, q1(30) As Double, q2(30) As Double, q3(30) As Double, q(30) As Double
Dim rd(1 To 3) As Single, i As Integer, j As Integer, t As Integer
Dim s(30) As Integer '单位线时段数
For j = 1 To 30
Qd(j) = Val(OLE1.object.Parent.Cells(j + 3, 3))
Next j
'赋值
rd(1) = 35.9
rd(2) = 14.2
rd(3) = 14.1
'先计算了第一、二、三行数据
q1(1) = 0
Qd(2) = 13
q1(2) = Qd(2)
q(2) = Qd(2) / rd(1) * 10
q2(3) = rd(3) / 10 * q(2)
q1(3) = Qd(3) - q2(3)
q(3) = q1(3) / rd(1) * 10
'计算第四个时段后
For i = 4 To 30
q3(i) = rd(3) / 10 * q(i - 2)
q2(i) = rd(2) / 10 * q(i - 1)
q1(i) = Qd(i) - q2(i) - q3(i)
q(i) = q1(i) / rd(1) * 10
If q1(i) < 0 Then q1(i) = 0: If q2(i) < 0 Then q2(i) = 0: If q3(i) < 0 Then q3(i) = 0: If q(i) < 0 Then q(i) = 0:
Next i
'Dim e As String
'j = 0
'For j = 1 To 30
'e = e & Str(9) & Str(Q1(j)) & Str(9) & Str(Q2(j)) & Str(9) & Str(Q3(j)) & Str(9) & Str(q(j))
'e = e & Str(13) & Str(10)
'Next j
'Text1.Text = e
'进行小数位数的取舍
For t = 1 To 29
q1(t) = Round(q1(t), 0): q2(t) = Round(q2(t), 0): q3(t) = Round(q3(t), 0): q(t) = Round(q(t), 0)
Next t
'输出到表中
i = 0
For i = 1 To 30
OLE1.object.Parent.Cells(i + 3, 5) = q1(i)
OLE1.object.Parent.Cells(i + 3, 6) = q2(i)
OLE1.object.Parent.Cells(i + 3, 7) = q3(i)
OLE1.object.Parent.Cells(i + 3, 8) = q(i)
Next i
End Sub
Private Sub Command2_Click()
OLE2.SizeMode = 2
OLE2.CreateLink "D:\桌面文件\大三下学期\水文预报\瞿思敏\单位线\单位线推流.xlsx"
OLE2.DoVerb 0 '激活Excel
Dim q(30) As Integer, q1(30) As Double, q2(30) As Double, q3(30) As Double, qe(30) As Double
Dim rd(1 To 4) As Single, i As Integer, j As Integer, t As Integer
For j = 1 To 30
q(j) = Val(OLE2.object.Parent.Cells(j + 3, 3))
Next j
'赋值
rd(1) = 42.5
rd(2) = 36.2
rd(4) = 15.8
q1(1) = rd(1) / 10 * q(1)
q1(2) = rd(1) / 10 * q(2)
q2(2) = rd(2) / 10 * q(1)
q1(3) = rd(1) / 10 * q(3)
q2(3) = rd(2) / 10 * q(2)
For i = 4 To 30
q1(i) = rd(1) / 10 * q(i)
q2(i) = rd(2) / 10 * q(i - 1)
q3(i) = rd(4) / 10 * q(i - 3)
Next i
i = 0
For i = 1 To 30
qe(i) = q1(i) + q2(i) + q3(i)
q1(i) = Round(q1(i), 0): q2(i) = Round(q2(i), 0): q3(i) = Round(q3(i), 0): qe(i) = Round(qe(i), 0)
OLE2.object.Parent.Cells(i + 3, 4) = q1(i)
OLE2.object.Parent.Cells(i + 3, 5) = q2(i)
OLE2.object.Parent.Cells(i + 3, 6) = q3(i)
OLE2.object.Parent.Cells(i + 3, 7) = qe(i)
Next i
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Command4_Click()
OLE1.SizeMode = 2
OLE1.CreateLink "D:\桌面文件\大三下学期\水文预报\瞿思敏\单位线\综合单位线算例.xlsx"
OLE1.DoVerb 0 '激活Excel
' VScroll1.Max = Width - Picture1.Width + 20
' VScroll1.LargeChange = Width / 10
' VScroll1.SmallChange = Width / 20
' VScroll1.Max = Height - Picture1.Height + 20
' VScroll1.LargeChange = Height / 10
' VScroll1.SmallChange = Height / 20
End Sub
Private Sub VScroll1_Change()
OLE1.Top = -VScroll1.Value
End Sub
Private Sub HScroll1_Change()
OLE1.Left = -HScroll1.Value
End Sub
评论0