Вызов функции MS Excel из MS Access VBA

Question

Я работаю над приложением MS Access, часть которого использует функцию распространения бета-версии. Поскольку у MS Access нет собственной функции бета-распространения, я использую функцию BetaDist из MS Excel. Я тестировал код в MS Excel и, похоже, успешно работает. В MS Access также хорошо работает код и генерирует правильные результаты, но время, затрачиваемое на Access, очень велико, чем время, затраченное Excel. Я размещаю часть кода, которая использует функцию BetaDist, а также самую медленную часть кода. Я хочу сократить время, затрачиваемое Access. Любая помощь приветствуется.

часть кода, который использует БЕТАРАСП:

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 не сложно реализовать. Почему бы не создать функцию VBA в Acces 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