差分

この文書の現在のバージョンと選択したバージョンの差分を表示します。

この比較画面にリンクする

流域流出計算:貯留関数法 [2012/08/09 14:46]
tys [マクロの説明]
流域流出計算:貯留関数法 [2012/08/13 12:22] (現在)
tys
ライン 1137: ライン 1137:
  
  
-{{ :流域流出計算:image01.jpg?650|計算条件シート}}+{{ :流域流出計算:image31.jpg?650|計算条件シート}}
 ;#; ;#;
 計算条件シート 計算条件シート
 ;#; ;#;
  
 +=== 河道諸元 ===
 +
 +{{ :流域流出計算:image32.jpg?650|河道諸元シート}}
 +;#;
 +河道諸元シート
 +;#;
 +
 +=== 流域諸元 ===
 +
 +{{ :流域流出計算:image33.jpg?650|流域諸元シート}}
 +;#;
 +流域諸元シート
 +;#;
 +
 +=== 雨量データ ===
 +
 +{{ :流域流出計算:image34.jpg?650|雨量データシート}}
 +;#;
 +雨量データシート
 +;#;
 +\\
 +
 +==== 計算結果 ====
 +
 +{{ :流域流出計算:image35.jpg?650|流域計算結果}}
 +;#;
 +流域計算結果
 +;#;
 +
 +{{ :流域流出計算:image36.jpg?650|河道計算結果}}
 +;#;
 +河道計算結果図
 +;#;
 +
 +{{ :流域流出計算:image37.jpg?650|作図データ}}
 +;#;
 +作図データ
 +;#;
 +
 +{{ :流域流出計算:image38.jpg?650|計算結果図}}
 +;#;
 +計算結果図
 +;#;
 +
 +
 +==== 注意事項 ====
 +
 + 本プログラムは、総合貯留関数法と通常の貯留関数法の両方が行えますが、総合貯留関数法と通常の貯留関数法では、K・P値はそれぞれ全く異なりますので注意してください。
 + ここで、総合貯留関数法とは貯留関数を貯留高(mm)と流出高(mm/hr)の関係で表現したもの、通常の貯留関数法とは、貯留関数を貯留量(m3)と流出量(m3/s)の関係で表現したものです。総合貯留関数法は貯留関数法を単位流域面積で表現したものと言い換えることができます。
 + 本や論文によっては、総合貯留関数法を単に「貯留関数法」と表記されている場合があり、特殊な手法ではなく、かなり一般的に利用されていますので、基礎式による確認が必要です。
 +===== VBAソースファイル =====
 +
 + 本マクロのソースを公開しますので、参考にしてください。
 +
 +<sxh vb tys-sfb_v_1_0_0.bas>
 +Option Explicit
 +Option Base 1
 +
 +'貯留関数による洪水流量計算
 +Sub main()
 +    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
 +    Dim ws5 As Worksheet, ws6 As Worksheet, ws7 As Worksheet
 +    Set ws1 = Sheets("計算条件")
 +    Set ws2 = Sheets("流域諸元")
 +    Set ws3 = Sheets("河道諸元")
 +    Set ws4 = Sheets("雨量データ")
 +    Set ws5 = Sheets("流域計算結果")
 +    Set ws6 = Sheets("河道計算結果")
 +    Set ws7 = Sheets("作図データ")
 +    
 +    Application.StatusBar = "データ読み込み中"
 +    data_read ws1, ws2, ws3, ws4
 +    inital_set ws5, ws6
 +    
 +    For m = 1 To m1     '流域数のループ
 +        Application.StatusBar = "流域計算中" & Str(m) & "/" & m1
 +        cal_basin m, ws5
 +    Next m
 +    For n = 1 To n1     '河道数のループ
 +        Application.StatusBar = "河道計算中" & Str(n) & "/" & n1
 +        cal_river n, ws6, ws7
 +    Next n
 +    
 +    Graph_Refresh2
 +    
 +    Application.StatusBar = False
 +End Sub
 +
 +Sub inital_set(ws5 As Worksheet, ws6 As Worksheet)
 +    Dim i As Integer, j As Integer, l As Integer
 +    For i = 1 To 50
 +        qb(i) = 0#
 +        qi(i) = 0#
 +        For n = 1 To 500
 +            q8sum(i, n) = 0#
 +        Next n
 +    Next i
 +    
 +    '   降雨量の計算   ---------------------------------------------------
 +    dn = d3 / d2
 +    For i = 1 To nt
 +        For l = 1 To dn
 +            i2 = (i - 1) * dn + l
 +            For j = 1 To nhyeto
 +                r1(j, i2) = r(j, i) / d3 * d2
 +            Next j
 +        Next l
 +    Next i
 +    i1 = Int(nt * dn)
 +    '結果書き込み用のシートのクリア
 +    ws5.Select
 +    Cells.Select
 +    Selection.ClearContents 'セルの値をクリア
 +    ws6.Select
 +    Cells.Select
 +    Selection.ClearContents 'セルの値をクリア
 +End Sub
 +
 +Sub cal_basin(m As Integer, ws5 As Worksheet)
 +    Dim i As Integer, l As Integer
 +        '流域の計算
 +        '初期値の消去
 +        For i = 1 To 500
 +            r2(i) = 0#
 +            r3(i) = 0#
 +            qr(i) = 0#
 +            qs(i) = 0#
 +            q1(i) = 0#
 +            q2(i) = 0#
 +            q3(i) = 0#
 +            q4(i) = 0#
 +            q5(i) = 0#
 +            q6(i) = 0#
 +            q7(i) = 0#
 +            q8(i) = 0#
 +        Next i
 +        
 +        '流域降雨     , 流出域降雨の計算
 +        r3(1) = r1(norain(m), 1)
 +        r2(1) = r1(norain(m), 1)
 +        
 +        For i = 2 To i1
 +            r3(i) = r3(i - 1) + r1(norain(m), i)
 +            r2(i) = r1(norain(m), i)
 +        Next i
 +        
 +        '浸透域有効降雨の計算
 +        rs(1) = 0#
 +        For i = 2 To i1
 +            rs(i) = 0#
 +            If r3(i) > sr(m) Then GoTo S1
 +        Next i
 +        
 +S1:     For i = i To i1
 +            rs(i) = 0#
 +            If r3(i) > sr(m) Then rs(i) = r3(i) - r3(i - 1)
 +            If r3(i - 1) < sr(m) Then rs(i) = r3(i) - sr(m)
 +        Next i
 +        
 +        '流出域 流出高さの計算
 +        i = 0
 +S2:     i = i + 1
 +        d5 = d1
 +S3:     i2 = Int(d2 / d5) + 1
 +        qt = 0#
 +        If i > 1 Then qt = qr(i - 1)
 +        rt = r2(i) / d2
 +        tq(1) = qt
 +        t1(i2) = rt
 +        t1(1) = 0#
 +        If i > 1 Then t1(1) = r2(i) / d2
 +        dt = d5
 +        qk = qt
 +        t1(1) = t1(i2)
 +        l = 1
 +S4:     l = l + 1
 +        t1(l) = (t1(i2) - t1(1)) * CDbl(l - 1) / CDbl(i2 - 1) + t1(1)
 +        qt = tq(l - 1)
 +        qk = qt
 +        t1(1) = t1(i2)
 +        rt = t1(l)
 +        k_p_cal 0#, kr(m), pr(m)
 +        If tq(1) = 0# Then GoTo S5
 +        If dt > 2# * kr(m) * pr(m) / tq(1) ^ (1# - pr(m)) Then GoTo S6
 +        If dt > 2# * kr(m) / tq(1) ^ (1# - pr(m)) Then GoTo S6
 +S5:     If qk = 0# Then GoTo S7
 +        If dt < 2# * kr(m) * pr(m) / qk ^ (1# - pr(m)) Then GoTo S7
 +        If dt < 2# * kr(m) / qk ^ (1# - pr(m)) Then GoTo S7
 +S6:     d5 = d5 / 2#
 +        GoTo S3
 +S7:     tq(l) = qk
 +        If l < i2 Then GoTo S4
 +        qr(i) = tq(i2)
 +        If i < i1 Then GoTo S2
 +        
 +        '浸透域流出データの計算
 +        i = 0
 +S8:     i = i + 1
 +        d5 = d1
 +S9:     i2 = Int(d2 / d5) + 1
 +        qt = 0#
 +        If i > 1 Then qt = qs(i - 1)
 +        rt = rs(i) / d2
 +        dt = d5
 +        tq(1) = qt
 +        t1(i2) = rt
 +        t1(1) = 0#
 +        If i > 1 Then t1(1) = rs(i - 1) / d2
 +        qk = qt
 +        t1(1) = t1(i2)
 +        l = 1
 +S10:    l = l + 1
 +        t1(l) = (t1(i2) - t1(1)) * CDbl(l - 1) / CDbl(i2 - 1) + t1(1)
 +        qt = tq(l - 1)
 +        qk = qt
 +        rt = t1(l)
 +        t1(1) = t1(i2)
 +        k_p_cal 0#, kr(m), pr(m)
 +        If tq(1) = 0 Then GoTo S11
 +        If dt > 2# * kr(m) * pr(m) / tq(1) ^ (1# - pr(m)) Then GoTo S12
 +        If dt > 2# * kr(m) / tq(1) ^ (1# - pr(m)) Then GoTo S12
 +S11:    If qk = 0# Then GoTo S13
 +        If dt < 2# * kr(m) * pr(m) / qk ^ (1# - pr(m)) Then GoTo S13
 +        If dt < 2# * kr(m) / qk ^ (1# - pr(m)) Then GoTo S13
 +S12:    d5 = d5 / 2#
 +        GoTo S9
 +S13:    tq(l) = qk
 +        If l < i2 Then GoTo S10
 +        qs(i) = tq(i2)
 +        If i < i1 Then GoTo S8
 +        
 +        '遅滞時間降雨量
 +        tl = tr(m) / d2
 +        For i = 1 To i1
 +            z1 = Int(tl)
 +            z2 = tl - z1
 +            q1(i + z1) = qr(i)
 +            q2(i + z1) = qs(i)
 +            q3(i + z1) = q1(i + z1)
 +            q4(i + z1) = q2(i + z1)
 +            If (i + z1 - 1) > 0 Then q3(i + z1) = q1(i + z1 - 1) + (q1(i + z1) - q1(i + z1 - 1)) * (1# - z2)
 +            If (i + z1 - 1) > 0 Then q4(i + z1) = q2(i + z1 - 1) + (q2(i + z1) - q2(i + z1 - 1)) * (1# - z2)
 +        Next i
 +        
 +        '流域 流出高データ
 +        For i = 1 To i1
 +            q5(i) = q3(i) * f(m) + q4(i) * (1# - f(m)) + 3.6 * bq(m) / aa(m)
 +            q6(i) = q5(i) * aa(m) / 3.6
 +        Next i
 +        
 +        '流入する河道への流量の受け渡し
 +        For i = 1 To i1
 +            q8sum(er(m), i) = q8sum(er(m), i) + q6(i)
 +        Next i
 +        
 +        qb(er(m)) = qb(er(m)) + bq(m)
 +        
 +        print_basin m             '計算結果出力(ファイル)
 +        
 +        print_basin2 m, ws5       '計算結果出力(ワークシート)
 +End Sub
 +
 +Sub cal_river(n As Integer, ws6 As Worksheet, ws7 As Worksheet)
 +    Dim i As Integer, l As Integer
 +        '河道の計算
 +        For i = 1 To i1
 +            q7(i) = q8sum(n, i)
 +        Next i
 +        
 +         '河道の上流に連結する河道の基底流量を足し合わせてその河道の基底流量を定義
 +        For i = 1 To n1
 +            If ek(i) = n Then qi(n) = qi(n) + qi(i)
 +        Next i
 +        qi(n) = qi(n) + qb(n)
 +        q7(1) = qi(n)
 +        q8(1) = qi(n)
 +        q2(1) = qi(n)
 +        For i = 2 To i1
 +            q7(i) = q7(i)
 +            q2(i) = q7(i - 1) + (q7(i) - q7(i - 1)) * (d2 - tk(n)) / d2
 +        Next i
 +        
 +        '繰り返し時間数のループ
 +        For i = 2 To i1
 +            d5 = d1
 +S1:         i2 = Int(d2 / d5) + 1
 +            tq(1) = q8(1)
 +            If i > 1 Then tq(1) = q8(i - 1)
 +            t1(i2) = q2(i)
 +            t1(1) = qi(n)
 +            If i > 1 Then t1(1) = q2(i - 1)
 +            dt = d5
 +            l = 1
 +            l = l + 1
 +            For l = 2 To i2
 +                t1(l) = (t1(i2) - t1(1)) * CDbl(l - 1) / CDbl(i2 - 1) + t1(1)
 +                qt = tq(l - 1)
 +                rt = (t1(l) + t1(l - 1)) / 2#
 +                qk = qt
 +                k_p_cal qi(n), kk(n), pk(n)
 +                If tq(1) = 0# Then GoTo S2
 +                If dt > 2# * kk(n) * pk(n) / tq(1) ^ (1# - pk(n)) Then GoTo S3
 +                If dt > 2# * kk(n) / tq(1) ^ (1# - pk(n)) Then GoTo S3
 +S2:             If qk = 0# Then GoTo S4
 +                If dt < 2# * kk(n) * pk(n) / qk ^ (1# - pk(n)) Then GoTo S4
 +                If dt < 2# * kk(n) / qk ^ (1# - pk(n)) Then GoTo S4
 +S3:             d5 = d5 / 2#
 +                GoTo S1
 +S4:             tq(l) = qk
 +            Next l
 +            q8(i) = tq(i2)
 +            If q8(i) < qi(n) Then q8(i) = qi(n)
 +        Next i
 +        For i = 1 To i1
 +            q8sum(ek(n), i) = q8sum(ek(n), i) + q8(i)
 +        Next i
 +        
 +        '計算結果出力(ファイル)
 +        print_river n
 +        
 +        '計算結果出力(ワークシート)
 +        print_river2 n, ws6
 +        
 +        If n = numgraph Then print_plot ws7  '作図データの書き込み
 +
 +End Sub
 +
 +'*************************  K-Pの計算 ********************************************
 +Sub k_p_cal(qi1 As Double, k As Double, p As Double)
 +    Dim rq1 As Double, qb1 As Double
 +    Dim i As Integer
 +    
 +    qp1 = 0#
 +    qq1 = 0#
 +    qm1 = 0#
 +    qn1 = 0#
 +    qk1 = qk
 +    qb1 = 0#
 +    rq1 = 0#
 +    
 +    For i = 1 To 750
 +        qe1 = 2# * rt - qt - 2# * (k * (qk1 ^ p) - k * (qt ^ p)) / dt
 +        qg1 = qk1 - qe1
 +        If Abs(qg1) < 0.0001 Then GoTo S1
 +        rq1 = qk1
 +        If qg1 > 0# Then qp1 = qg1
 +        If qg1 > 0# Then qq1 = rq1
 +        If qg1 < 0# Then qm1 = qg1
 +        If qg1 < 0# Then qn1 = rq1
 +        qa = qk1
 +        qk1 = qe1
 +        If i = 1 Then GoTo S2
 +        qk1 = qq1 - qp1 * (qq1 - qn1) / (qp1 - qm1)
 +        qb1 = qk1
 +        If qa = qb1 Then GoTo S1
 +S2:     If qk1 < 0# Then qk1 = 0#
 +    Next i
 +S1: qk = qk1
 +    If qk < qi1 Then qk = qi1
 +End Sub
 +
 +'*********************** データの読み込み *******************************
 +Sub data_read(ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet)
 +    Dim i As Integer, j As Integer
 +    '計算条件の読み込み
 +        d1 = ws1.Cells(2, 3)
 +        d2 = ws1.Cells(3, 3)
 +        d3 = ws1.Cells(4, 3)
 +        nt = ws1.Cells(5, 3)
 +        m1 = ws1.Cells(6, 3)
 +        n1 = ws1.Cells(7, 3)
 +        nhyeto = ws1.Cells(8, 3)
 +    
 +    'グラフ描画河道の読み込み
 +        numgraph = ws1.Cells(9, 3)
 +        
 +    '流域諸元の読み込み
 +        For i = 1 To m1
 +            kr(i) = ws2.Cells(i + 2, 2)
 +            pr(i) = ws2.Cells(i + 2, 3)
 +            tr(i) = ws2.Cells(i + 2, 4)
 +            f(i) = ws2.Cells(i + 2, 5)
 +            sr(i) = ws2.Cells(i + 2, 6)
 +            aa(i) = ws2.Cells(i + 2, 7)
 +            bq(i) = ws2.Cells(i + 2, 8)
 +            er(i) = ws2.Cells(i + 2, 9)
 +            norain(i) = ws2.Cells(i + 2, 10)
 +        Next i
 +    '河道諸元の読み込み
 +        For i = 1 To n1
 +            kk(i) = ws3.Cells(i + 2, 2)
 +            pk(i) = ws3.Cells(i + 2, 3)
 +            tk(i) = ws3.Cells(i + 2, 4)
 +            ek(i) = ws3.Cells(i + 2, 5)
 +        Next i
 +    '雨量データの読み込み
 +        For i = 1 To nt
 +            For j = 1 To nhyeto
 +                r(j, i) = ws4.Cells(i + 2, j + 1)
 +            Next j
 +        Next i
 +
 +End Sub
 +
 +'******************** 計算結果のファイルへの出力 ******************************
 +Sub print_basin(m As Integer)
 +    Dim NAME As String, OUFL1 As String
 +    Dim i As Integer
 +    Dim D2z As String, R1z As String, R3z As String, RSz As String, QRz As String, QSz As String
 +    Dim Q5z As String, Q6z As String
 +    NAME = ActiveWorkbook.Path
 +    OUFL1 = "RUN-R.OUT"
 +    '   流域計算出力    ------------------------------------------------
 +    If m = 1 Then Open NAME + "\" + OUFL1 For Output As #2
 +        Print #2, "流域 ("; m; ")"
 +        Print #2, "流域の諸元    "
 +        Print #2, "K 値               = "; Format(Format(kr(m), "##0.00"), "@@@@@@")
 +        Print #2, "P 値               = "; Format(Format(pr(m), "##0.00"), "@@@@@@")
 +        Print #2, "遅滞時間(hr)    TR = "; Format(Format(tr(m), "##0.00"), "@@@@@@")
 +        Print #2, "流出率          F  = "; Format(Format(f(m), "##0.00"), "@@@@@@")
 +        Print #2, "飽和雨量(mm/hr) RS = "; Format(Format(sr(m), "##0.00"), "@@@@@@")
 +        Print #2, "流域面積(km2)   A  = "; Format(Format(aa(m), "##0.00"), "@@@@@@")
 +        Print #2, "基底流量(m3/s)  BQ = "; Format(Format(bq(m), "##0.00"), "@@@@@@")
 +        Print #2, "連立する河道 NO    = "; Format(er(m), "@@@@@")
 +        Print #2, "     時間   降雨量  累加雨量  浸透 R   流出 Q   浸透 Q   総合 Q      流出量 "
 +        Print #2, "     (時)    (㎜)     (㎜)     (㎜)     (㎜)    (㎜)     (㎜)         (m3/s)"
 +        For i = 1 To i1
 +            D2z = Format(Format(i * d2, "#####0.00"), "@@@@@@@@@")
 +            R1z = Format(Format(r1(norain(m), i), "#####0.00"), "@@@@@@@@@")
 +            R3z = Format(Format(r3(i), "#####0.00"), "@@@@@@@@@")
 +            RSz = Format(Format(rs(i), "#####0.00"), "@@@@@@@@@")
 +            QRz = Format(Format(qr(i), "#####0.00"), "@@@@@@@@@")
 +            QSz = Format(Format(qs(i), "#####0.00"), "@@@@@@@@@")
 +            Q5z = Format(Format(q5(i), "#####0.00"), "@@@@@@@@@")
 +            Q6z = Format(Format(q6(i), "######0.00"), "@@@@@@@@@@")
 +            Print #2, D2z; R1z; R3z; RSz; QRz; QSz; Q5z; Q6z
 +        Next i
 +     If m = m1 Then Close #2
 +End Sub
 +
 +'******************** 計算結果のファイルへの出力 ******************************
 +Sub print_river(n As Integer)
 +    Dim NAME As String, OUFL2 As String
 +    Dim i As Integer
 +    Dim D2z As String, Q7z As String, Q2z As String, Q8z As String
 +    NAME = ActiveWorkbook.Path
 +    OUFL2 = "RUN-K.OUT"
 +    If n = 1 Then Open NAME + "\" + OUFL2 For Output As #3
 +    '   河道計算結果の出力 -----------------------------------------------
 +        Print #3, "河道 ("; n; ")"
 +        Print #3, "河道の諸元 "
 +        Print #3, "K 値           = "; Format(Format(kk(n), "##0.00"), "@@@@@@")
 +        Print #3, "P 値           = "; Format(Format(pk(n), "##0.00"), "@@@@@@")
 +        Print #3, "遅滞時間(hr)TK = "; Format(Format(tk(n), "##0.00"), "@@@@@@")
 +        Print #3, "     時間     流入量    流入量    流出量   "
 +        Print #3, "                     (遅滞時間)"
 +        Print #3, "     (時)     (m3/s)   (m3/s)    (m3/s)"
 +        For i = 1 To i1
 +            D2z = Format(Format(i * d2, "#####0.00"), "@@@@@@@@@")
 +            Q7z = Format(Format(q7(i), "######0.00"), "@@@@@@@@@@")
 +            Q2z = Format(Format(q2(i), "######0.00"), "@@@@@@@@@@")
 +            Q8z = Format(Format(q8(i), "######0.00"), "@@@@@@@@@@")
 +            Print #3, D2z; Q7z; Q2z; Q8z
 +        Next i
 +    If n = n1 Then Close #3
 +End Sub
 +
 +'******************** 計算結果のワークシートへの出力 ******************************
 +Sub print_basin2(m As Integer, ws5 As Worksheet)
 +    Dim i As Integer, j As Integer
 +    ws5.Select
 +    '   流域計算出力    ------------------------------------------------
 +    If m = 1 Then
 +        ws5.Cells(2, 1) = "時間(hr)"
 +        For i = 1 To i1
 +            ws5.Cells(i + 2, 1) = i * d2
 +        Next i
 +        For j = 1 To nhyeto
 +            ws5.Cells(2, (j - 1) * 2 + 2) = "降雨量(" & j & ") (mm)"
 +            ws5.Cells(2, (j - 1) * 2 + 3) = "累積降雨量(" & j & ") (mm)"
 +            For i = 1 To i1
 +                ws5.Cells(i + 2, (j - 1) * 2 + 2) = r1(norain(m), i)
 +                ws5.Cells(i + 2, (j - 1) * 2 + 3) = r3(i)
 +            Next i
 +        Next j
 +    End If
 +    ws5.Cells(1, nhyeto * 2 + 2 + (m - 1)) = "流域 (" + CStr(m) + ")"
 +    ws5.Cells(2, nhyeto * 2 + 2 + (m - 1)) = "流域流出量(m3/s)"
 +    For i = 1 To i1
 +        ws5.Cells(i + 2, nhyeto * 2 + 2 + (m - 1)) = q6(i)
 +    Next i
 +    If m = m1 Then
 +        For i = 1 To (nhyeto * 2 + 1)
 +            Columns(i).AutoFit                        '列幅を整える
 +            If i = 1 Then
 +                Columns(i).NumberFormatLocal = "0.0_ "              '桁数を揃える
 +            Else
 +                Columns(i).NumberFormatLocal = "0.00_ "   '桁数を揃える
 +            End If
 +        Next i
 +        For i = (nhyeto * 2 + 1) To m1 + (nhyeto * 2 + 1)
 +            Columns(i).NumberFormatLocal = "0.000_ "        '桁数を揃える
 +            Columns(i).AutoFit                              '列幅を整える
 +        Next i
 +    End If
 +End Sub
 +
 +'******************** 計算結果のワークシートへの出力 ******************************
 +Sub print_river2(n As Integer, ws6 As Worksheet)
 +    Dim i As Integer
 +    ws6.Select
 +    If n = 1 Then
 +        ws6.Cells(2, 1) = "時間(hr)"
 +        For i = 1 To i1
 +            ws6.Cells(i + 2, 1) = i * d2
 +        Next i
 +    End If
 +    ws6.Cells(1, (n - 1) * 2 + 2) = "河道 (" + CStr(n) + ")"
 +    ws6.Cells(2, (n - 1) * 2 + 2) = "河道流入量(m3/s)"
 +    ws6.Cells(2, (n - 1) * 2 + 3) = "河道流出量(m3/s)"
 +    For i = 1 To i1
 +        ws6.Cells(i + 2, (n - 1) * 2 + 2) = q7(i)
 +        ws6.Cells(i + 2, (n - 1) * 2 + 3) = q8(i)
 +    Next i
 +    If n = n1 Then
 +        Columns(1).NumberFormatLocal = "0.0_ "          '桁数を揃える
 +        Columns(1).AutoFit                              '列幅を整える
 +        For i = 2 To n1 * 2 + 1
 +            Columns(i).NumberFormatLocal = "0.000_ "    '桁数を揃える
 +            Columns(i).AutoFit                          '列幅を整える
 +        Next i
 +    End If
 +End Sub
 +
 +
 +'******************** 計算結果のワークシートへの出力(グラフ用) *************************
 +Sub print_plot(ws7 As Worksheet)
 +    Dim i As Integer
 +    
 +    ws7.Cells(1, 3) = "NO." & numgraph
 +    ws7.Select
 +    For i = 1 To i1
 +        ws7.Cells(i + 1, 4) = q8(i)
 +    Next i
 +End Sub
 +
 +
 +'******************** 計算結果図の修正 *************************
 +Private Sub Graph_Refresh2()
 +'グラフの修正
 +    Dim g_range As String
 +    Sheets("計算結果図").Select
 +    
 +    
 +    ActiveChart.SeriesCollection(2).Select
 +    Selection.Delete
 +    ActiveChart.SeriesCollection(1).Select
 +    Selection.Delete
 +    
 +    g_range = "B1:C" & CStr(nt + 1) & ",D1:D" & CStr(nt + 1)
 +'
 +    Sheets("作図データ").Select
 +    Range(g_range).Select
 +    Selection.Copy
 +    Sheets("計算結果図").Select
 +    ActiveChart.SeriesCollection.Paste Rowcol:=xlColumns, SeriesLabels:=True, _
 +        CategoryLabels:=True, Replace:=True
 +'    ActiveChart.SeriesCollection.Paste Rowcol:=xlColumns, SeriesLabels:=True, _
 +        CategoryLabels:=True, Replace:=False, NewSeries:=True
 +        
 +    With ActiveChart
 +        .HasTitle = True
 +        .ChartTitle.Characters.Text = "計算結果 " & "河道" & "NO." & numgraph
 +    End With
 +
 +End Sub
 +
 +</sxh>
 
流域流出計算/貯留関数法.txt · 最終更新: 2012/08/13 12:22 by tys
[unknown button type]
 
特に明示されていない限り、本Wikiの内容は次のライセンスに従います: CC Attribution-Share Alike 3.0 Unported
Recent changes RSS feed Donate Powered by PHP Valid XHTML 1.0 Valid CSS Driven by DokuWiki