0

tblPaySch に保存された 4 つの「契約」日付に関連付けられた 4 つのスケジュールされた支払いがあるプロジェクトがあります。

4 つの日付 (ID 1 から 4 で識別) と予想金額を定義する配列を試みており、それを tblTrans と比較して予想支払額を超えているかどうかを確認し、超過している場合はその取引日を「実際の」日付。

配列に問題があるか、ループに問題があります。ID1 の結果 (つまり、従業員の予想される支払いとそれに一致した取引日) を取得できますが、他の 3 つの ID を取得できません。

GetDate(prjID) を使用してクエリで呼び出して、prjId を関数に渡します。

これが私のコードです：

'This function is a multidimensional array that can hold multiple values
Public Function GetDate(intID As Long) As Variant

    Dim intTot As Long
    Dim i As Integer
    Dim i2 As Integer

    'Define recordset to get expected payment data
    Dim rsPrj As DAO.Recordset 
    Set rsPrj = CurrentDb.OpenRecordset("SELECT * FROM tblPaySch WHERE PrjID =" & intID, dbOpenSnapshot)

    'Define recordset to get transaction data
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("Select * from tblTrans where PrjID=" & intID, dbOpenSnapshot)


    'Store milestone payments in RA
    Dim RA(0 To 4, 0 To 4, 0 To 4) As Variant
    RA(0, 0, 0) = rsPrj!MSCdbID 'payment Id, 4 of which are associated with each PrjID
    RA(0, 1, 0) = rsPrj!PayIncGST 'expected payment amount, of 4 different totals
    RA(0, 0, 1) = rs!RefDate 'Actual date from tblTrans
    intTot = 0

    Do While rs.EOF
        intTot = intTot + rs!Amt 'refers to the amount of the transaction
        '-----Check for milestone exceeded
        For i = 0 To 4
            For i2 = 0 To 4
                If IsNull(RA(i, i2, 1) And RA(i, i2, 0) <= intTot) Then
                        RA(i, i2, 1) = rs!RefDate
                 End If
            Next i2
        Next i

    Loop

    GetDate = RA(0, 0, 1)

    Debug.Print RA(1, 0, 0)
    Debug.Print RA(0, 1, 0)
    Debug.Print RA(0, 0, 1)

End Function

前もって感謝します。明白な初心者の間違いを許してください。これは私の初めての配列関数です。

4

1 に答える 1

0

わかりました、あなたがやろうとしていることはわかりました。これを少し単純化できるかどうか見てみましょう。

まず、テーブル構造を用意します (DatePaid は更新する値ですか?):

tblPaySch は次のとおりです。

PrjID    PayID    ExpectedAmt    DatePaid(trying to find from tblTrans) 
1          1         $100 
1          2         $150 
1          3         $100 
1          4         $200

tblTrans は: (日付形式が DD/MM/YYYY であり、常に時系列でソートされていると仮定)

PrjID AmtPaid   PayDate 
1       $250    12/03/12
2       $765    05/05/12
3       $150    06/05/12
1       $200    07/06/12
1       $100    08/07/12

予想される支払い額を満たすには複数のトランザクションが必要になる可能性があると想定しましたが、予想よりも多くの支払いが発生する可能性もあります。サンプル データで指定した列名をフィールド名に使用しました。

うまくいけば、コードに十分なコメントを追加して、あなたにとって役立つことを願っています.

Private Function GetDate(intID As Long) As Variant
    Dim intTot As Long
    Dim i As Integer
    Dim i2 As Integer
    Dim loopCounter As Integer

    'Define recordset to get expected payment data
    Dim rsPrj As DAO.Recordset
    Set rsPrj = CurrentDb.OpenRecordset("SELECT * FROM tblPaySch WHERE PrjID =" & intID)

    'Define recordset to get transaction data
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("Select * from tblTrans where PrjID=" & intID, dbOpenSnapshot)

    ' get rs.recordcount and go back to the beginning
    rs.MoveLast
    rs.MoveFirst

    ' Only need to store the records returned and the 2 fields Payment amount and payment date
    Dim RA() As Variant
    ReDim RA(0 To rs.RecordCount - 1, 0 To 1)

    ' Populate the array with the transaction records
    i = 0
    Do Until rs.EOF
        RA(i, 0) = rs!AmtPaid
        RA(i, 1) = rs!PayDate
        If rs.RecordCount <> 0 Then
            rs.MoveNext
            i = i + 1
        End If
    Loop

    intTot = 0
    loopCounter = 0 ' This will ensure we don't check transactions more than once

    ' First we're going to loop through the payment schedule and see at which payment from table transaction
    ' the scheduled payment is met
    Do Until rsPrj.EOF
        ' First we check if the last payment was enough to make this scheduled payment to and if so mark it paid
        ' otherwise check for the next transaction that gives us enough
        If intTot < rsPrj!ExpectedAmt Then
            For i = loopCounter To UBound(RA)
                intTot = intTot + RA(i, 0)
                If intTot >= rsPrj!ExpectedAmt Then ' if the current payment is = or greater than expected set the date
                    rsPrj.edit
                    rsPrj!DatePaid = RA(i, 1)
                    rsPrj.Update
                    intTot = intTot - rsPrj!ExpectedAmt  ' update our remainder
                    loopCounter = loopCounter + 1 ' increase this so we don't double check a transaction
                    Exit For ' exit loop and move to the next expected payment
                End If
            Next i
        Else
            rsPrj.edit
            rsPrj!DatePaid = RA(i, 1)
            rsPrj.Update
            intTot = intTot - rsPrj!ExpectedAmt
        End If
        If rsPrj.RecordCount <> 0 Then
            rsPrj.MoveNext
        End If
    Loop
End Function
于 2013-03-08T16:24:45.780 に答える