Question

我有一个项目，其中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

提前谢谢，请原谅任何明显的noobie错误，这是我的第一个阵列功能。

Answer 1

好的，我想我知道你要做什么了。让我们看看我们是否可以简化这一点。

首先你有你的表结构（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

循环在3d数组访问vba不返回所有结果

1 个答案: