Xin chào mọi người
mình có bài VBA về tính nước ngầm và nươc mặt (sông), có đoạn code, phần trên thì không vấn đề gì nhưng khi chạy thì giá trị Q_s ( Q_s = H ^ (1 / 3) ở hàm cuối cùng (tính cho hàm trên ứng với các giá trị Y) toàn báo lỗi (Run-time error '5' Invalid procedure call or argument ) hoặc báo lỗi overflow. Nếu mình thay số mũ (1/3) bằng số > 1 thì lại chạy được.
có thể là lỗi vượt giá trị, nhưng khi cắt hàm cuối cùng sang phần mới thi không báo lỗi.
còn khi bỏ qua lỗi đó thì phương trình
Y2 = Y1 - (Q_s - Qat_s) * Y1 * (Y1 + 3) / (Q_s * (5 + Y1))
lại báo lối chia cho 0 (diveded by zero )
mình rất cần sự giúp dỡ của mọi người
mình cũng xin gửi file bài tập này ( phần này trong model 6 trong bài tập)
Public Module6'
Option Explicit
Sub calcstream(evapstream As Double, Qstream As Double, ROvol As Double, counter As Integer)
Dim ContinueLoop As Boolean
Dim H_st As Double 'Head of stream water
Dim Q_st As Double 'flow in stream
Dim Q_sb As Double 'flow from stream bank to stream via stream bed
Dim Averain As Double 'Average rain
Dim Eo_st As Double 'Evaporation on stream
Dim PE As Double 'Potential Evaporation
Dim Et As Double 'actual Evapotranspiration
Dim Prec_st As Double 'precipitation in stream
Dim bankhead As Double 'stream bank head level
Dim aqSA As Double 'aquifer surface area
Dim sbSA As Double 'stream bank surface area
Dim stSA As Double 'stream surface area
Dim st_width As Double 'stream width
Dim st_length As Double 'stream length
Dim sb_width As Double 'stream bank width
Dim st_bed_elev As Double 'stream bed elevation
Dim st_K As Double 'stream bed hydraulic conductivity
Dim st_bed_thic As Double 'stream bed thickness
Dim n As Double 'Stream bed roughness (Manning's n)
Dim So As Double 'Stream longitudinal slope
Dim stw_L As Double 'stream water level
Dim St_depth As Double
aqSA = Worksheets("inputdata").Cells(32, 2)
sbSA = Worksheets("inputdata").Cells(33, 2)
st_K = Worksheets("inputdata").Cells(16, 2)
st_width = Worksheets("inputdata").Cells(14, 2)
st_bed_thic = Worksheets("inputdata").Cells(15, 2)
st_length = (Worksheets("inputdata").Cells(19, 2) * 1000)
sb_width = Worksheets("inputdata").Cells(10, 2)
st_bed_elev = Worksheets("inputdata").Cells(20, 2)
n = Worksheets("inputdata").Cells(17, 2)
So = Worksheets("inputdata").Cells(18, 2)
stSA = Worksheets("inputdata").Cells(34, 2)
'assign values to variables
Averain = Worksheets("calcdata").Cells(counter, 1)
PE = Worksheets("PEvalues").Cells(counter, 2)
Q_sb = Worksheets("calcdata").Cells(counter, 15)
Et = Worksheets("calcdata").Cells(counter, 6)
'****************************************************************************************************
'Precipitation in stream
Prec_st = (Averain / 1000) * stSA
'Evaporation from stream (assume Evaporation is Potential Precipitation !! )
Eo_st = PE * stSA
evapstream = Eo_st
'output Evaporation from stream to calculations sheet
Worksheets("calcdata").Cells(counter, 18) = evapstream
'stream water level
Call Streamdepth(ROvol, Prec_st, Eo_st, Q_sb, st_width, St_depth, counter)
stw_L = St_depth
'head of stream water
H_st = stw_L + st_bed_thic + st_bed_elev
Worksheets("calcdata").Cells(counter, 19) = H_st
'flow in stream
Qstream = (st_width * stw_L) ^ (5 / 3) / (st_width + 2 * stw_L) ^ (2 / 3)
'output flow in stream to calculations sheet
Worksheets("calcdata").Cells(counter, 20) = Qstream
End Sub
Function Streamdepth(ROvol As Double, Prec_st As Double, Eo_st As Double, Q_sb As Double, _
st_width As Double, St_depth As Double, counter As Integer)
' this function applied the Newton's method to work out the head for stream water
Dim i As Integer
Dim ContinueLoop As Boolean
Dim Y1 As Double 'Depth
Dim Y2 As Double 'iterative step
Dim Qat_s As Double ' actual discharge (from mass balance equation) in stream
Dim Q_s As Double 'Stream flow
Qat_s = ROvol + Prec_st + Q_sb - Eo_st
Y1 = Worksheets("inputdata").Cells(21, 2)
If counter > 2 Then
Y1 = Worksheets("calcdata").Cells(counter - 1, 20)
End If
ContinueLoop = True
Do
If Q_s - Qat_s < 0.001 Then
ContinueLoop = False
End If
' set up the first value of stream water head and dischange
Call cal_Q_s(Y1, Q_s, st_width)
' calculate some stream water head
Y2 = Y1 - (Q_s - Qat_s) * Y1 * (Y1 + 3) / (Q_s * (5 + Y1))
' calculate fow to supply for equation above for each stream water head
Y1 = Y2
Worksheets("calcdata").Cells(counter, 24) = Q_s
Loop Until ContinueLoop = False
Worksheets("calcdata").Cells(counter, 20) = Y1
End Function
Function cal_Q_s(Y1 As Double, Q_s As Double, st_width As Double)
'This function calculate the stream flow with each stream water head
'to supply for the function above
Dim H As Double
Dim So As Double
Dim n As Double
So = Worksheets("inputdata").Cells(18, 2)
n = Worksheets("inputdata").Cells(17, 2)
H = (st_width * Y1) ^ 5 * So ^ (3 / 2) / _
((st_width + 2 * Y1) ^ 2 * n ^ 3)
Q_s = H ^ (1 / 3)
End Function
mình có bài VBA về tính nước ngầm và nươc mặt (sông), có đoạn code, phần trên thì không vấn đề gì nhưng khi chạy thì giá trị Q_s ( Q_s = H ^ (1 / 3) ở hàm cuối cùng (tính cho hàm trên ứng với các giá trị Y) toàn báo lỗi (Run-time error '5' Invalid procedure call or argument ) hoặc báo lỗi overflow. Nếu mình thay số mũ (1/3) bằng số > 1 thì lại chạy được.
có thể là lỗi vượt giá trị, nhưng khi cắt hàm cuối cùng sang phần mới thi không báo lỗi.
còn khi bỏ qua lỗi đó thì phương trình
Y2 = Y1 - (Q_s - Qat_s) * Y1 * (Y1 + 3) / (Q_s * (5 + Y1))
lại báo lối chia cho 0 (diveded by zero )
mình rất cần sự giúp dỡ của mọi người
mình cũng xin gửi file bài tập này ( phần này trong model 6 trong bài tập)
Public Module6'
Option Explicit
Sub calcstream(evapstream As Double, Qstream As Double, ROvol As Double, counter As Integer)
Dim ContinueLoop As Boolean
Dim H_st As Double 'Head of stream water
Dim Q_st As Double 'flow in stream
Dim Q_sb As Double 'flow from stream bank to stream via stream bed
Dim Averain As Double 'Average rain
Dim Eo_st As Double 'Evaporation on stream
Dim PE As Double 'Potential Evaporation
Dim Et As Double 'actual Evapotranspiration
Dim Prec_st As Double 'precipitation in stream
Dim bankhead As Double 'stream bank head level
Dim aqSA As Double 'aquifer surface area
Dim sbSA As Double 'stream bank surface area
Dim stSA As Double 'stream surface area
Dim st_width As Double 'stream width
Dim st_length As Double 'stream length
Dim sb_width As Double 'stream bank width
Dim st_bed_elev As Double 'stream bed elevation
Dim st_K As Double 'stream bed hydraulic conductivity
Dim st_bed_thic As Double 'stream bed thickness
Dim n As Double 'Stream bed roughness (Manning's n)
Dim So As Double 'Stream longitudinal slope
Dim stw_L As Double 'stream water level
Dim St_depth As Double
aqSA = Worksheets("inputdata").Cells(32, 2)
sbSA = Worksheets("inputdata").Cells(33, 2)
st_K = Worksheets("inputdata").Cells(16, 2)
st_width = Worksheets("inputdata").Cells(14, 2)
st_bed_thic = Worksheets("inputdata").Cells(15, 2)
st_length = (Worksheets("inputdata").Cells(19, 2) * 1000)
sb_width = Worksheets("inputdata").Cells(10, 2)
st_bed_elev = Worksheets("inputdata").Cells(20, 2)
n = Worksheets("inputdata").Cells(17, 2)
So = Worksheets("inputdata").Cells(18, 2)
stSA = Worksheets("inputdata").Cells(34, 2)
'assign values to variables
Averain = Worksheets("calcdata").Cells(counter, 1)
PE = Worksheets("PEvalues").Cells(counter, 2)
Q_sb = Worksheets("calcdata").Cells(counter, 15)
Et = Worksheets("calcdata").Cells(counter, 6)
'****************************************************************************************************
'Precipitation in stream
Prec_st = (Averain / 1000) * stSA
'Evaporation from stream (assume Evaporation is Potential Precipitation !! )
Eo_st = PE * stSA
evapstream = Eo_st
'output Evaporation from stream to calculations sheet
Worksheets("calcdata").Cells(counter, 18) = evapstream
'stream water level
Call Streamdepth(ROvol, Prec_st, Eo_st, Q_sb, st_width, St_depth, counter)
stw_L = St_depth
'head of stream water
H_st = stw_L + st_bed_thic + st_bed_elev
Worksheets("calcdata").Cells(counter, 19) = H_st
'flow in stream
Qstream = (st_width * stw_L) ^ (5 / 3) / (st_width + 2 * stw_L) ^ (2 / 3)
'output flow in stream to calculations sheet
Worksheets("calcdata").Cells(counter, 20) = Qstream
End Sub
Function Streamdepth(ROvol As Double, Prec_st As Double, Eo_st As Double, Q_sb As Double, _
st_width As Double, St_depth As Double, counter As Integer)
' this function applied the Newton's method to work out the head for stream water
Dim i As Integer
Dim ContinueLoop As Boolean
Dim Y1 As Double 'Depth
Dim Y2 As Double 'iterative step
Dim Qat_s As Double ' actual discharge (from mass balance equation) in stream
Dim Q_s As Double 'Stream flow
Qat_s = ROvol + Prec_st + Q_sb - Eo_st
Y1 = Worksheets("inputdata").Cells(21, 2)
If counter > 2 Then
Y1 = Worksheets("calcdata").Cells(counter - 1, 20)
End If
ContinueLoop = True
Do
If Q_s - Qat_s < 0.001 Then
ContinueLoop = False
End If
' set up the first value of stream water head and dischange
Call cal_Q_s(Y1, Q_s, st_width)
' calculate some stream water head
Y2 = Y1 - (Q_s - Qat_s) * Y1 * (Y1 + 3) / (Q_s * (5 + Y1))
' calculate fow to supply for equation above for each stream water head
Y1 = Y2
Worksheets("calcdata").Cells(counter, 24) = Q_s
Loop Until ContinueLoop = False
Worksheets("calcdata").Cells(counter, 20) = Y1
End Function
Function cal_Q_s(Y1 As Double, Q_s As Double, st_width As Double)
'This function calculate the stream flow with each stream water head
'to supply for the function above
Dim H As Double
Dim So As Double
Dim n As Double
So = Worksheets("inputdata").Cells(18, 2)
n = Worksheets("inputdata").Cells(17, 2)
H = (st_width * Y1) ^ 5 * So ^ (3 / 2) / _
((st_width + 2 * Y1) ^ 2 * n ^ 3)
Q_s = H ^ (1 / 3)
End Function
File đính kèm
Lần chỉnh sửa cuối: