从MS Access VBA调用MS Excelfunction
我正在使用一个MS Access应用程序，其中一部分使用Beta分发function。 由于MS Access没有它自己的Beta分布function我正在使用从MS Excel调用BetaDist函数。 我testing了MS Excel中的代码，它似乎运行成功。 在MS Access中，代码也能正常工作并生成正确的结果，但Access所花费的时间比Excel占用的时间要高。 我发布了使用BetaDist函数的代码部分，也是代码最慢的部分。 我想减lessAccess所花费的时间。 任何帮助表示赞赏。
使用BetaDist的部分代码：
For i = 1 To UBound(arrBetaParam) If arrBetaParam(i).Alpha <= 0 Or arrBetaParam(i).Beta <= 0 Or tryOutValue > arrBetaParam(i).ExpValue Then dblTempEP = 0 Else If tryOutValue > arrBetaParam(i).LastKnownGoodValue Then dblTempEP = 0 Else dblTempEP = 1 End If Dim bt As Double bt = -1 On Error Resume Next bt = Excel.WorksheetFunction.BetaDist(tryOutValue, arrBetaParam(i).Alpha, arrBetaParam(i).Beta, 0, arrBetaParam(i).ExpValue) tj = bt If bt > -1 Then If bt > 1 Then bt = 1 If bt < 0 Then bt = 0 arrBetaParam(i).LastKnownGoodValue = tryOutValue dblTempEP = 1 - bt End If On Error GoTo 0 End If OEP = OEP + dblTempEP * arrBetaParam(i).Rate 'sumRate = sumRate + arrBetaParam(i).Rate Next 由于必须打开Excel应用程序，因此您的代码可能需要很长时间。
BetaDist并不复杂。 为什么不在Acces VBA中创build一个VBA函数？ 这是公式：
f(x) = B(alpha,beta)-1 xalpha-1(1-x)beta-1
在这里我find了一个体面的实现 虽然没有testing：
Option Explicit Const n As Long = 200 ' increase for accuracy, decrease for speed Public aa As Double Public bb As Double Function BetaDist1(x As Double, a As Double, b As Double) Dim d1 As Double Dim d2 As Double Dim n1 As Long Dim n2 As Long aa = a bb = b n1 = x * n n2 = n - n1 d1 = SimpsonInt(0, x, n1) d2 = SimpsonInt(x, 1, n2) BetaDist1 = d1 / (d1 + d2) End Function Function SimpsonInt(ti As Double, tf As Double, ByVal n As Long) As Double ' shg 2006 ' Returns the integral of Func (below) from ti to tf _ using Composite Simpson's Rule over n intervals Dim i As Double ' index Dim dH As Double ' step size Dim dOdd As Double ' sum of Func(i), i = 1, 3, 5, 7, ... n-1, ie, n/2 values Dim dEvn As Double ' sum of Func(i), i = 2, 4, 6, ... n-2 ie, n/2 - 1 values ' 1 + (n/2) + (n/2 - 1) + 1 = n+1 function evaluations If n < 1 Then Exit Function If n And 1 Then n = n + 1 ' n must be even dH = (tf - ti) / n For i = 1 To n - 1 Step 2 dOdd = dOdd + Func(ti + i * dH) Next i For i = 2 To n - 2 Step 2 dEvn = dEvn + Func(ti + i * dH) Next i SimpsonInt = (Func(ti) + 4# * dOdd + 2# * dEvn + Func(tf)) * dH / 3# ' weighted sum End Function Function Func(t As Double) As Double Func = t ^ (aa - 1) * (1 - t) ^ (bb - 1) End Function
你可以这样做：
Dim xls As Excel.Application Set xls = New Excel.Application ' Begin loop. bt = xls.WorksheetFunction.BetaDist(tryOutValue, arrBetaParam(i).Alpha, arrBetaParam(i).Beta, 0, arrBetaParam(i).ExpValue) ' End loop. xls.Quit Set xls = Nothing