從MS Access VBA調用MS Excel函數

Question

我正在使用MS Access應用程序，其中一部分使用Beta Distribution功能。 由於MS Access沒有自己的Beta Distribution函數，我正在使用從MS Excel調用BetaDist函數。 我已經在MS Excel中測試了代碼，它似乎運行成功。 在MS Access中，代碼工作正常並生成正確的結果，但Access所花費的時間非常高於Excel所用的時間。 我發布了使用BetaDist函數的代碼部分，也是代碼中最慢的部分。 我想減少Access所花費的時間。 任何幫助表示贊賞。

使用BetaDist的Code的一部分：

    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

在這里，我發現了一個不錯 但是沒有測試它：

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