Question

我正在使用MS Access应用程序，其中一部分使用Beta Distribution功能。由于MS Access没有自己的Beta Distribution功能，我正在使用MS Excel中的 BetaDist 功能。我已经在MS Excel中测试了代码，它似乎运行成功。在MS Access中，代码工作正常并生成正确的结果，但Access所花费的时间非常高于Excel所用的时间。我发布了使用BetaDist函数的代码部分，也是代码中最慢的部分。我想减少Access所花费的时间。任何帮助表示赞赏。

使用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

Answer 1

由于必须打开Excel应用程序，您的代码可能需要很长时间。

BetaDist实现起来并不复杂。为什么不在Acces VBA中创建VBA功能。这是公式：

f(x) = B(alpha,beta)-1 xalpha-1(1-x)beta-1

Here我找到了一个不错的实施方案。但是没有测试它：

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, i.e., n/2 values
    Dim dEvn        As Double  ' sum of Func(i), i =   2, 4, 6,  ... n-2  i.e., 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

Answer 2

你可以这样做：

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

从MS Access VBA调用MS Excel函数

2 个答案: