循环不会在 Access VBA 中终止

Question

我有一个叫做“CurveInterpolateRecordset”的函数，如下：

Function CurveInterpolateRecordset(rsCurve As Recordset, InterpDate As Date) As Double

    Dim I As Long

    Dim x1 As Date, x2 As Date, y1 As Double, y2 As Double, x As Date
    CurveInterpolateRecordset = Rnd()
    If rsCurve.RecordCount <> 0 Then

        I = 1
        rsCurve.MoveFirst

        x1 = CDate(rsCurve.Fields("MaturityDate"))
        y1 = CDbl(rsCurve.Fields("ZeroRate"))
        If InterpDate = CDate(rsCurve.Fields("MaturityDate")) Then CurveInterpolateRecordset = CDbl(rsCurve.Fields("ZeroRate")): Exit Function
        'Do While Not rsCurve.EOF
        rsCurve.MoveNext
        Do While (CDate(rsCurve.Fields("MaturityDate")) <= InterpDate)
            If rsCurve.EOF Then CurveInterpolateRecordset = CDbl(rsCurve.Fields("ZeroRate")): Exit Function

            If InterpDate = CDate(rsCurve.Fields("MaturityDate")) Then CurveInterpolateRecordset = CDbl(rsCurve.Fields("ZeroRate")): Exit Function

            If InterpDate > CDate(rsCurve.Fields("MaturityDate")) Then

            x1 = CDate(rsCurve.Fields("MaturityDate"))
            y1 = CDbl(rsCurve.Fields("ZeroRate"))

            End If

            rsCurve.MoveNext
            If rsCurve.EOF Then CurveInterpolateRecordset = y1: Exit Function

        Loop

            x2 = CDate(rsCurve.Fields("MaturityDate"))
            y2 = CDbl(rsCurve.Fields("ZeroRate"))

            CurveInterpolateRecordset = y1 + (y2 - y1) * CDate((InterpDate - x1) / (x2 - x1))
    End If


        Debug.Print I, InterpDate, x1, x2, y1, y2
End Function

此循环将通过使用最近日期的值进行插值，从而为特定日期插入缺失值。

我有一个日期表，其中一些需要插值，所以我使用另一个函数来遍历记录集并将函数传递给每条记录的相应日期，以便插值。

Sub SampleReadCurve()

Dim rs As Recordset
Dim iRow As Long, iField As Long
Dim strSQL As String
Dim CurveID As Long
Dim MarkRunID As Long
Dim ZeroCurveID As String

CurveID = 124
MarkRunID = 10167
ZeroCurveID = "'" & CurveID & "-" & MarkRunID & "'"
'strSQL = "SELECT * FROM dbo_VolatilityInput WHERE ZeroCurveID='124-10167'"
strSQL = "SELECT * FROM dbo_VolatilityInput WHERE ZeroCurveID=" & ZeroCurveID & " ORDER BY MaturityDate"
Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)



If rs.RecordCount <> 0 Then

Do While Not rs.EOF

    rs.MoveFirst
    Debug.Print vbCrLf
    Debug.Print "First", rs!ZeroCurveID, rs!MaturityDate, rs!ZeroRate, rs!DiscountFactor
    rs.MoveLast
    Debug.Print "Last", rs!ZeroCurveID, rs!MaturityDate, rs!ZeroRate, rs!DiscountFactor
    Debug.Print "There are " & rs.RecordCount & " records and " _
                             & rs.Fields.Count & " fields."

    Dim BucketTermAmt As Long
    Dim BucketTermUnit As String
    Dim BucketDate As Date
    Dim MarkAsOfDate As Date
    Dim InterpRate As Double
    MarkAsOfDate = rs!MarkAsOfDate
    BucketTermAmt = 3
    BucketTermUnit = "m"
    BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MarkAsOfDate)
    InterpRate = CurveInterpolateRecordset(rs, BucketDate)
    Debug.Print BucketDate, InterpRate



   rs.MoveNext

Loop

   End If

End Sub

对于一个单独的记录和日期，第一个函数可以正常工作。但是，当我执行第二个函数时，循环不断重复，程序崩溃。我不明白为什么会发生这种情况，因为在第二个循环中显然有一个结束条件。记录集只有 76 条记录，所以不是很大。

Answer 1

从while 循环中删除以rs.MoveFirst 开头并以rs.MoveLast 结尾的块。它们应该在if 内，但在while 之前。