Dim P(25), EI(25), PE(25), A(25), AU(25), FR(25), W(25), WU(25), WL(25), WD(25), E(25), EU(25), EL(25), ED(25), R2(25), R3(25), RS(25), RG(25), RSS(25), RIMP(25), QR(25), QRG(25), QRSS(25), QRSP(25), S(25), UH(3), q(3) As SingleDim N, m, K, B, C, D, EX, SM, SSM, MP, KG, KSS, KKSS, KGD, KSSD, KKGD, KKG, WM, WWMM, WUM, WLM, WDM, DT, UN, QRSS0, QRG0, F, i, j As SinglePrivate Sub Command1_Click()Static ik As Integerik = ik + 1Command1.Caption = "您还需计算" & 7 - ik & " 次"If ik = 7 Then Command1.Enabled = FalseSet xlbook = GetObject(App.Path & "\" & "xaj.xls")xlbook.application.Visible = True: xlbook.windows(1).Visible = TrueSet xlsheet1 = xlbook.worksheets("sheet1")Set xlsheet2 = xlbook.worksheets("sheet2")K = xlsheet1.Cells(3, 1)C = xlsheet1.Cells(3, 2)B = xlsheet1.Cells(3, 3)SM = xlsheet1.Cells(3, 5)WUM = xlsheet1.Cells(3, 6)WLM = xlsheet1.Cells(3, 7)WDM = xlsheet1.Cells(3, 8)EX = xlsheet1.Cells(3, 9)KG = xlsheet1.Cells(3, 10)KSS = xlsheet1.Cells(3, 11)KKG = xlsheet1.Cells(3, 12)KKSS = xlsheet1.Cells(3, 13)DT = xlsheet1.Cells(3, 14)UH(1) = xlsheet1.Cells(3, 15)UH(2) = xlsheet1.Cells(3, 16)UH(3) = xlsheet1.Cells(3, 17)WU(0) = xlsheet1.Cells(3, 18)WL(0) = xlsheet1.Cells(3, 19)WD(0) = xlsheet1.Cells(3, 20)FR(0) = xlsheet1.Cells(3, 21)S(0) = xlsheet1.Cells(3, 22)QRSS(0) = xlsheet1.Cells(3, 23)QRG(0) = xlsheet1.Cells(3, 24)F = xlsheet1.Cells(3, 25)MP = 0: RS(0) = 0: W(0) = 150WM = (WUM + WLM + WDM)WWMM = WM * (1 + B)SSM = SM * (1 + EX)KSSD = (1 - (1 - (KG + KSS)) ^ (DT / 24)) / (1 + KG / KSS)KGD = KSSD * KG / KSSKKGD = KKG ^ (DT / 24)N = 24For i = 1 To NP(i) = xlsheet1.Cells(5, i + 1)EI(i) = xlsheet1.Cells(8, i + 1)PE(i) = P(i) - K * EI(i)Next iFor i = 1 To N '计算产流If PE(i) > 0 ThenA(i) = WWMM * (1 - (1 - W(i - 1) / WM) ^ (1 / (1 + B)))If PE(i) + A(i) >= WWMM ThenR2(i) = PE(i) - (WM - W(i - 1))ElseR2(i) = PE(i) - (WM - W(i - 1) - WM * (1 - (PE(i) + A(i)) / WWMM) ^ (1 + B)) End IfIf PE(i) > 0 ThenFR(i) = R2(i) / PE(i)ElseFR(i) = 1 - (1 - S(i - 1) / WM) ^ (B / (1 + B))End IfAU(i) = SSM * (1 - (1 - S(i - 1) / SM) ^ (1 / (1 + EX)))If PE(i) + AU(i) < SSM ThenRS(i) = (PE(i) - SM + S(i - 1) + SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * FR(i) RSS(i) = (SM - SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * KSSD * FR(i)RG(i) = (SM - SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * KGD * FR(i)S(i) = (SM - SM * (1 - (PE(i) + AU(i)) / SSM) ^ (1 + EX)) * (1 - KSSD - KGD) ElseRS(i) = (PE(i) - SM + S(i - 1)) * FR(i)RSS(i) = SM * KSSD * FR(i)RG(i) = SM * KGD * FR(i)S(i) = SM * (1 - KSSD - KGD)End IfElseR2(i) = 0FR(i) = 1 - (1 - W(i - 1) / WM) ^ (B / (1 + B))RS(i) = 0RSS(i) = S(i - 1) * KSSD * FR(i)RG(i) = S(i - 1) * KGD * FR(i)S(i) = S(i - 1) * (1 - KSSD - KGD)End IfRIMP(0) = 0RIMP(i) = P(i) * MPR3(i) = RS(i) + RSS(i) + RG(i)Next iFor m = 1 To 3 ‘计算汇流q(m) = F * UH(m) / (3.6 * DT)Next mQRSP(0) = 0QRSP(1) = 0 * (RS(1) + RIMP(1)) + q(1) * (RS(0) + RIMP(0))QRSP(2) = 0 * (RS(2) + RIMP(2)) + q(1) * (RS(1) + RIMP(1)) + q(2) * (RS(0) + RIMP(0))For H = 3 To NQRSP(H) = 0 * (RS(H) + RIMP(H)) + q(1) * (RS(H - 1) + RIMP(H - 1)) + q(2) * (RS(H - 2) + RIMP(H - 2)) + q(3) * (RS(H - 3) + RIMP(H - 3))Next HQRSS(0) = 40For L = 1 To NQRSS(L) = QRSS(L - 1) * KKSS ^ (DT / 24) + RSS(L) * (1 - KKSS ^ (DT / 24)) * F / (3.6 * DT)Next LQRG(0) = 20For L = 1 To NQRG(L) = QRG(L - 1) * KKGD ^ (DT / 24) + RG(L) * (1 - KKGD ^ (DT / 24)) * F / (3.6 * DT)Next LFor m = 0 To NQR(m) = QRSP(m) + QRSS(m) + QRG(m)Next mFor j = 1 To N '计算蒸散发If WU(j - 1) + P(j) < K * EI(j) ThenEU(j) = WU(j - 1) + P(j)If WL(j - 1) / WLM < C ThenIf WL(j - 1) < C * (K * EI(j) - EU(j)) ThenEL(j) = WL(j - 1)ED(j) = C * (K * EI(j) - EU(j)) - EL(j)ElseEL(j) = C * (K * EI(j) - EU(j))ED(j) = 0End IfElseEL(j) = (K * EI(j) - EU(j)) * WL(j - 1) / WLMED(j) = 0End IfElseEU(j) = K * EI(j)EL(j) = 0ED(j) = 0End IfIf WU(j - 1) + P(j) - R2(j) - EU(j) >= WUM ThenIf WL(j - 1) - EL(j) + WU(j - 1) + P(j) - R2(j) - EU(j) - WUM >= WLM ThenWU(j) = WUMWL(j) = WLMIf WD(j - 1) - ED(j) + (WL(j - 1) - EL(j) + WU(j - 1) + P(j) - R2(j) - EU(j) - WUM - WLM) >= WDM ThenWD(j) = WDMEnd IfElseWU(j) = WUMWL(j) = WL(j - 1) + EL(j) + (WU(j - 1) + P(j) - R2(j) - EU(j) - WUM)WD(j) = WD(j - 1) - ED(j)End IfElseWU(j) = WU(j - 1) + P(j) - R2(j) - EU(j)WL(j) = WL(j - 1) - EL(j)WD(j) = WD(j - 1) - ED(j)End IfW(j) = WU(j) + WL(j) + WD(j)E(j) = EU(j) + EL(j) + ED(j)Next jFor j = 0 To NFor L = 4 To 21xlsheet2.Cells(5 + j, L) = ""Next LNext jFor j = 1 To N '输出xlsheet2.Cells(5 + j, 2) = P(j)xlsheet2.Cells(5 + j, 3) = EI(j)xlsheet2.Cells(5 + j, 4) = PE(j)xlsheet2.Cells(5 + j, 5) = RS(j)xlsheet2.Cells(5 + j, 6) = RSS(j)xlsheet2.Cells(5 + j, 7) = RG(j)xlsheet2.Cells(5 + j, 8) = R3(j)'xlsheet2.cells(5 + j, 9) = RIMP(j)xlsheet2.Cells(5 + j, 9) = S(j)xlsheet2.Cells(5 + j, 10) = EU(j)xlsheet2.Cells(5 + j, 11) = EL(j)xlsheet2.Cells(5 + j, 12) = ED(j)xlsheet2.Cells(5 + j, 13) = E(j)Next jFor H = 0 To Nxlsheet2.Cells(5 + H, 14) = WU(H)xlsheet2.Cells(5 + H, 15) = WL(H)xlsheet2.Cells(5 + H, 16) = WD(H)xlsheet2.Cells(5 + H, 19) = QRSS(H)xlsheet2.Cells(5 + H, 20) = QRG(H)xlsheet2.Cells(5 + H, 17) = W(H)xlsheet2.Cells(5 + H, 18) = QRSP(H)xlsheet2.Cells(5 + H, 21) = QR(H) Next HEnd SubPrivate Sub Command2_Click()EndEnd Sub。