[英]Calling MS Excel function from MS Access VBA
I am working an MS Access application a part of which uses Beta Distribution function. 我正在使用MS Access应用程序,其中一部分使用Beta Distribution功能。 Since MS Access does not have Beta Distribution function of its own I'm using calling BetaDist function from MS Excel.
由于MS Access没有自己的Beta Distribution函数,我正在使用从MS Excel调用BetaDist函数。 I've tested the code in MS Excel and it seems to run successfully.
我已经在MS Excel中测试了代码,它似乎运行成功。 In MS Access also the code is working fine and generating correct results but the time taken by Access is very high than the time taken by Excel.
在MS Access中,代码工作正常并生成正确的结果,但Access所花费的时间非常高于Excel所用的时间。 I'm posting the part of code which utilizes BetaDist function and also the slowest portion of the code.
我发布了使用BetaDist函数的代码部分,也是代码中最慢的部分。 I want to reduce the time taken by Access.
我想减少Access所花费的时间。 Any help is appreciated.
任何帮助表示赞赏。
Part of Code which utilizes BetaDist: 使用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
Your code is probably taking so long due to the fact it has to open the Excel
application. 由于必须打开
Excel
应用程序,您的代码可能需要很长时间。
BetaDist is not complicated to implement. BetaDist实现起来并不复杂。 Why not create a VBA function in Acces VBA.
为什么不在Acces VBA中创建VBA功能。 Here is the formula:
这是公式:
f(x) = B(alpha,beta)-1 xalpha-1(1-x)beta-1
Here I found a decent implementation. 在这里,我发现了一个不错 Didn't test it though:
但是没有测试它:
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
You could do like this: 你可以这样做:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.