Использование функции для создания новой таблицы в Access VBA

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 7/2/2015 до 7/30/2015.

Я заинтересован в выборе значения ZeroRate в случаях, когда MarkAsofDate и MaturityDate отличаются на 3 месяца, например, 7/2/2015 и 7/5/2015; 7/3/2015 и 7/6/2015; 7/4/2015 и 7/7/2015; и так далее.

Я хочу создать список этих экземпляров для каждого 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 

Как я могу изменить функцию, которую я написал, чтобы он мог производить список, что мне нужно, а не одно конкретное значение? Благодарю.

EDIT

Это функция интерполяции ссылки ранее.

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 в ваши функции и печати линий (я удалить многословие с помощью rs.Fields() только с восклицательным знаком):

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 

Вы даже можете быть в состоянии использовать только раствор SQL. Запросы доступа могут использовать пользовательские функции VBA, если они определены как публичные функции и помещены в модуль. Просто пройти необходимые рядные параметры в функцию, а не все набора записей (но изменить функцию, чтобы принимать такие параметры):

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