0

値をサブ関数に読み込み、条件付きループを実行してから、出力値をワークシートに出力しようとしています。しかし、私はいくつかの問題に直面しています。サブ関数 infiltPrint では、セルに印刷する値を取得できないようです。

Option Explicit

Dim dz() As Double
Dim WC() As Double
Dim fc() As Double
Dim NL, i As Integer

Dim sumdrain As Double
Dim infl As Double


Sub main()
    Call InfiltRead
    Call infilt
    Call Infiltprint
End Sub


Sub InfiltRead()
    Dim dz() As Double
    Dim WC() As Double
    Dim fc() As Double
    Dim NL, i As Integer
    Dim sumdrain As Double
    sumdrain = 0
    Dim infl As Double

'read inputs 
    NL = 10
    infl = Cells(2, 1)

    Application.ScreenUpdating = False
    Worksheets("Sheet1").Activate

    ReDim dz(NL)
    ReDim WC(NL)
    ReDim fc(NL)

    For i = 1 To NL
        dz(i) = Cells(1 + i, 3)
        WC(i) = Cells(1 + i, 7)
        fc(i) = Cells(1 + i, 5)
    Next i    
End Sub


Sub infilt()
    Dim j As Integer
    j = 1
    While (infl > 0) And (j <= NL)
        If infl > (fc(i) - WC(j)) * dz(j) Then
            infl = infl - (fc(i) - WC(j)) * dz(j)
            WC(j) = fc(i)
        Else
            WC(j) = WC(j) + infl / dz(j): infl = 0
        End If
        j = j + 1
    Wend
    If infl > 0 Then
        sumdrain = sumdrain + infl
        infl = 0
    End If
End Sub


Sub Infiltprint()
    Dim col As Double
    Dim rw As Double
    col = 7
    For rw = 2 To 11
        Cells(rw + 1, col).Value = WC()
    Next rw
End Sub

「Cells(Row + 1, col) = WC()」という行でタイプの不一致が発生し続けます

おそらくこれが私のコードの唯一のエラーではないことはわかっています。率直に言って、潜入潜水艦から値を出力する方法がわかりません。サブメインを使ってみた...

4

1 に答える 1

1

次のバージョンのコードが出力されます。以下に示すいくつかの点が変更されます。

あなたが抱えていた主な問題は、WC 配列をワークシートにコピーすることでした。配列全体を個々のセルに割り当てようとしていました。

修正は、WC配列全体を、配置したいセルの完全なセットに割り当てることでした。これが機能するには、WCを転置する必要がありました。通常、配列を範囲に割り当てるには、WC を Variant としてディメンション化する必要があり ("Dim WC As Variant")、新しいコードはそれを反映しています。

また、変数の再宣言を一部削除し、3 つの配列のインデックス作成方法を変更して、配列の下限と上限をカウンターに合わせました。

intfilt() サブルーチンでは、ループ内のインデックスとして i を使用しましたが、初期化も反復もしていませんでした。これも変更されています。

cpearson.comは、VBA コーディング (配列の操作を含む) についてよく整理された詳細なリソースです。あなたはそれをチェックしたいかもしれません。

  Option Explicit

  Dim dz() As Double
  Dim WC As Variant
  Dim fc() As Double
  Dim NL As Long, i As Long       '<- Integer gets converted to Long internally, so do it directly
                                  '<- Way you did it results in Variant type for i
  Dim sumdrain As Double
  Dim infl As Double

  Sub main()
     InfiltRead  <- "Call" not needed
     infilt
     Infiltprint
  End Sub

  Sub InfiltRead() 
     sumdrain = 0   '<- variables in this sub are already declared, don't redeclare
     'read inputs
     NL = 10
     infl = Cells(2, 1).Value
     Application.ScreenUpdating = False ' <- if processing lots of data, would want to turn off auto sheet recalculation as well
     Worksheets("Sheet1").Activate  
     ReDim dz(1 To NL)                    '<- set lower bound to avoid default value of 0
     ReDim WC(1 To NL)        '
     ReDim fc(1 To NL)
     For i = 1 To NL
        dz(i) = Cells(1 + i, 3).Value     '<- could assign each range directy to an array, but this ok
        WC(i) = Cells(1 + i, 7).Value
        fc(i) = Cells(1 + i, 5).Value
     Next i
     Application.ScreenUpdating = True     '<- cleanup code
  End Sub

  Sub infilt()
     Dim j As Long
     i = 1                     '<- DEBUG placeholder - you used i in this sub, but did not initialize or iterate it
     j = 1
     While (infl > 0) And (j <= NL)
        If infl > (fc(i) - WC(j)) * dz(j) Then
           infl = infl - (fc(i) - WC(j)) * dz(j)
           WC(j) = fc(i)
        Else
           WC(j) = WC(j) + infl / dz(j)
           infl = 0
        End If
        j = j + 1
        i = i + 1             '<- DEBUG placeholder iteration
     Wend
     If infl > 0 Then
        sumdrain = sumdrain + infl
        infl = 0
     End If
  End Sub

  Sub Infiltprint()
     Dim col As Long
     Dim rw As Long
     rw = 2
     col = 9                   '<- Changed from 7 to 9 for debugging (so original values would not be overwritten)
     Range(Cells(rw, col), Cells(rw + NL - 1, col)).Value = _
        Application.Transpose(WC)                   '<- needed to get proper references for assignment
  End Sub
于 2013-02-15T04:31:50.247 に答える