在Access VBA中存储数组

我已经在Access VBA中编写了一个子例程,在这里显示以供参考: 在Access VBA中的strSQL中循环date 。 具体如下:

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 MaxOfMarkAsofDate As Date Dim userdate As String CurveID = 15 Dim I As Integer Dim x As Date userdate = InputBox("Please Enter the Date (mm/dd/yyyy)") x = userdate For I = 0 To 150 MaxOfMarkAsofDate = x - I strSQL = "SELECT * FROM VolatilityOutput WHERE CurveID=" & CurveID & " AND MaxOfMarkAsofDate=#" & MaxOfMarkAsofDate & "# ORDER BY MaxOfMarkasOfDate, MaturityDate" Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges) If rs.RecordCount <> 0 Then rs.MoveFirst rs.MoveLast Dim BucketTermAmt As Long Dim BucketTermUnit As String Dim BucketDate As Date Dim MarkAsOfDate As Date Dim InterpRate As Double BucketTermAmt = 3 BucketTermUnit = "m" BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MaxOfMarkAsofDate) InterpRate = CurveInterpolateRecordset(rs, BucketDate) Debug.Print BucketDate, InterpRate End If Next I End Function 

运行这个子程序计算一个76个数字的范围。 我想采取这76个数字,并在下面的函数中使用它们作为“ZeroCurveInput”。

 Function EWMA(ZeroCurveInput As Range, Lambda As Double) As Double Dim vZeros() As Variant vZeros = ZeroCurveInput Dim Price1 As Double, Price2 As Double Dim SumWtdRtn As Double Dim I As Long Dim m As Double Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double vZeros = ZeroCurveInput m = BucketTermAmt For I = 2 To UBound(vZeros, 1) Price1 = Exp(-vZeros(I - 1, 1) * (m / 12)) Price2 = Exp(-vZeros(I, 1) * (m / 12)) LogRtn = Log(Price1 / Price2) RtnSQ = LogRtn ^ 2 WT = (1 - Lambda) * Lambda ^ (I - 2) WtdRtn = WT * RtnSQ SumWtdRtn = SumWtdRtn + WtdRtn Next I EWMA = SumWtdRtn ^ (1 / 2) End Function 

我原本在Excel VBA编码这个函数,我试图将其移植到Access VBA。 在Excel中,我只是读取76个数字的列作为范围,并将其标注为variables以存储为数组,然后在函数中使用它。 但是,我不能使用Access中的范围属性来做类似的事情,我不知道该用什么来代替。

我将如何将数字存储为数组,然后将它们传递给函数?

您也可以简单地将SampleReadCurve中的数字写入表格,然后循环遍历整个表格。 所以,你的子会改变为这个(作为一个旁边,这是否工作?你正在创build一个Sub和结束一个函数…):

 Sub SampleReadCurve() Dim rs As Recordset Dim rs2 as Recordset Dim iRow As Long, iField As Long Dim strSQL As String Dim CurveID As Long Dim MarkRunID As Long Dim MaxOfMarkAsofDate As Date Dim userdate As String CurveID = 15 Dim I As Integer Dim x As Date userdate = InputBox("Please Enter the Date (mm/dd/yyyy)") x = userdate For I = 0 To 150 MaxOfMarkAsofDate = x - I strSQL = "SELECT * FROM VolatilityOutput WHERE CurveID=" & CurveID & " AND MaxOfMarkAsofDate=#" & MaxOfMarkAsofDate & "# ORDER BY MaxOfMarkasOfDate, MaturityDate" Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges) Set rs2 = CurrentDb.OpenRecordset("MyNewTable") If rs.RecordCount <> 0 Then rs.MoveFirst rs.MoveLast Dim BucketTermAmt As Long Dim BucketTermUnit As String Dim BucketDate As Date Dim MarkAsOfDate As Date Dim InterpRate As Double BucketTermAmt = 3 BucketTermUnit = "m" BucketDate = DateAdd(BucketTermUnit, BucketTermAmt, MaxOfMarkAsofDate) InterpRate = CurveInterpolateRecordset(rs, BucketDate) Debug.Print BucketDate, InterpRate rs2.AddNew rs2("BucketDate") = BucketDate rs2("InterpRate") = InterpRate rs2.Update End If Next I End Function 

那么你的EWMA函数看起来像这样:

 Function EWMA(Lambda As Double) As Double Dim Price1 As Double, Price2 As Double Dim SumWtdRtn As Double Dim I As Long Dim m As Double Dim rec as Recordset Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double m = BucketTermAmt Set rec = CurrentDB.OpenRecordset("SELECT InterpRate FROM MyNewTable") I = 2 Do While rec.EOF = False Price1 = Exp(-rec("InterpRate")(I - 1, 1) * (m / 12)) Price2 = Exp(-rec("InterpRate")(I, 1) * (m / 12)) LogRtn = Log(Price1 / Price2) RtnSQ = LogRtn ^ 2 WT = (1 - Lambda) * Lambda ^ (I - 2) WtdRtn = WT * RtnSQ SumWtdRtn = SumWtdRtn + WtdRtn I = I + 1 Loop EWMA = SumWtdRtn ^ (1 / 2) End Function 

有几种不同的方法可以做到这一点,包括使用你所build议的数组。 如果你需要的只是76个号码,你可以使用一个集合。 collections的好处是你不需要事先知道有多less物品在里面。

下面是一个使用集合的简单工作示例:

 Sub TestColl() Dim TestCollection As Collection Set TestCollection = CreateColl() LoopThruColl TestCollection End Sub Function CreateColl() As Collection Dim MyColl As Collection Set MyColl = New Collection Dim i As Integer For i = 1 To 5 MyColl.Add i * 2 Next i Set CreateColl = MyColl End Function Sub LoopThruColl(CollToLoop As Collection) Dim i As Integer For i = 2 To CollToLoop.Count Debug.Print i, CollToLoop.Item(i - 1), CollToLoop.Item(i) Next i End Sub