0

我有一个项目，其中 4 个预定付款与 4 个“合同”日期相关联，存储在 tblPaySch 但是，有时我们会在不同日期（“实际”）日期收到不同金额的付款（存储在 tblTrans）

我正在尝试定义 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 回答