Question

我是MS Access VBA的新手，并且很难将函数应用于记录集数据。

基本上我正在处理表格的表格：

CurveID MarkRunID MarkAsOfDate ZeroCurveID MaturityDate ZeroRate    DiscountFactor
15      10091     7/2/2015    15-10091    7/2/2015    0.007499923   1
15      10091     7/2/2015    15-10091    7/5/2015    0.007499923   0.999979452
15      10091     7/2/2015    15-10091    8/4/2015    0.00899634    0.999186963
15      10091     7/2/2015    15-10091    9/5/2015    0.008993128   0.998473566
15      10091     7/2/2015    15-10091    10/2/2015   0.005496191   0.998615618
...      ...       ....        ...         ...            ...       ...
15      10102     7/3/2015    15-10102    7/6/2015  0.007499769 0.99993836
15      10102     7/3/2015    15-10102    8/4/2015  0.008996451 0.999211581
15      10102     7/3/2015    15-10102    9/3/2015  0.008993128 0.998473566
...      ...       ....        ...         ...            ...       ...

来自MarkAsofDate 2015年7月2日至2015年7月30日。

我有兴趣在MarkAsofDate和MaturityDate相差3个月的情况下选择ZeroRate值，例如2015年7月2日和2015年7月5日; 2015年7月3日和2015年7月6日; 2015年7月4日和2015年7月7日;等等。

我想为表中的每个MarkAsofDate创建这些实例的列表。如果给定实例的表中没有ZeroRate值，我编写了一个函数（CurveInterpolateRecordset）来插入最近日期的值。

要创建此列表，我有以下子例程：

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_ZeroCurvePoints WHERE ZeroCurveID='124-10167'"
    strSQL = "SELECT * FROM dbo_ZeroCurvePoints WHERE ZeroCurveID=" & ZeroCurveID & " ORDER BY MaturityDate"
    Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)

    If rs.RecordCount <> 0 Then
        rs.MoveFirst
        Debug.Print vbCrLf
        Debug.Print "First", rs.Fields("ZeroCurveID"), rs.Fields("MaturityDate"), rs.Fields("ZeroRate"), rs.Fields("DiscountFactor")
        rs.MoveLast
        Debug.Print "Last", rs.Fields("ZeroCurveID"), rs.Fields("MaturityDate"), rs.Fields("ZeroRate"), rs.Fields("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 = #7/31/2015#
        BucketTermAmt = 3
        BucketTermUnit = "m"
        BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MarkAsOfDate)
        InterpRate = CurveInterpolateRecordset(rs, BucketDate)
        Debug.Print BucketDate, InterpRate
    End If


End Sub

基本上它将函数（CurveInterpolateRecordset）应用于特定的CurveID，MarkasOfDate和MaturityDate。它会为我插入一个值，而不是列表。输出是这样的：

First         124-10167     7/31/2015      4.99986301870823E-03        1 
Last          124-10167     7/31/2045      0.026229762828488           0.454995484723086 
There are 67 records and 4 fields.
 1            10/31/2015    10/30/2015    12/14/2015     6.84415740792136E-03        6.86250850507399E-03 
10/31/2015     6.84456521008031E-03

如何更改我编写的函数，以便生成我需要的列表，而不是一个特定的值？谢谢。

修改

这是前面提到的插值函数。

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

Answer 1

简单地将If/Then逻辑包装在Do While Loop中，该MarkAsDate遍历记录集的每条记录，将记录的相应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 # <-------------CHANGE HERE BucketTermAmt = 3 BucketTermUnit = "m" BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MarkAsOfDate) InterpRate = CurveInterpolateRecordset(rs, BucketDate) Debug.Print BucketDate, InterpRate rs.MoveNext Loop End If传递到您的函数中并打印行（我删除了使用的详细程度rs.Fields（）只带一个感叹号）：

SELECT ZeroCurveID, MaturityDate, ZeroRate, DiscountFactor,
       DateAdd("m", 3, MarkAsOfDate) As BucketDate, 
       CurveInterpolateRecordset(ZeroCurveID, 
                                 MarkAsOfDate, 
                                 MaturityDate,
                                 DateAdd("m", 3, MarkAsOfDate)) As InterpRate    
FROM dbo_ZeroCurvePoints 
WHERE ZeroCurveID = '124-10167' 
ORDER BY MaturityDate

您甚至可以只使用SQL解决方案。如果访问查询被定义为公共函数并放置在模块中，则它们可以使用用户定义的VBA函数。只需将所需的内联参数传递给函数而不是整个记录集（但修改函数以接受这些参数）：

{{1}}

使用函数在Access VBA中创建新表

1 个答案: