我正在尝试更快地计算Access中的中位数。你可以看到下面的代码,它一次查询一个项目代码,进行排序,然后计算中位数。有时会有600个商品代码,这些商品每个都有1000多个与之相关的基础。我正在使用的特定表格总共有150,000个记录,而且它的速度非常慢。是否有更好的方法可以同时计算每个记录中位数,而不是一次计算一个项目代码。
Function FIncPercentile(ByVal posCode As Single, ByVal k As Single, ByVal tbl As String) As Variant
Dim rstRec As Recordset
Dim db As Database
Dim n As Integer
Dim i As Single
Dim res, d1, d2 As Currency
' Create recordset from query
Set db = CurrentDb
Set rstRec = db.OpenRecordset("SELECT Co, Base " & _
"FROM " & tbl & " " & _
"WHERE Code = " & pos & " " & _
"ORDER BY Base ASC;")
' Skip if there are no matches
If IsNull(rstRec!base) Or rstRec.RecordCount = 0 Then
FBasePercentile = Null
Exit Function
End If
' Count records
rstRec.MoveLast
n = rstRec.RecordCount
rstRec.MoveFirst
' Calculate the index where k is the percentile
i = n * k
' Test the decimal and find value accordingly
If i = Int(i) Then
rstRec.Move i - 1
d1 = rstRec!base
rstRec.MoveNext
d2 = rstRec!base
FIncPercentile = (d1 + d2) / 2
Else
i = Round(i + 0.5, 0)
rstRec.Move i - 1
FIncPercentile = rstRec!base
End If
End Function
答案 0 :(得分:2)
Access中没有中间函数。 Excel有一个,但我相信它只限于30个数字,所以即使你想尝试使用自动化功能,我也不相信它适用于你的情况。
我认为通过微调你的功能并让微软的Jet引擎预先编译你的查询,你可能会看到显着的速度提升。
在所有这些变化之前和之后计时,看看是否有任何明显的差异
我纠正了一些可能不是拼写错误的拼写错误 - 我假设CODE是一个长整数 - 我可能也错了。我的更改也以'***************
开头创建预编译参数查询
创建名为“ qdfPrepMedian ”
的新查询复制/粘贴SQL&gt;&gt; PARAMETERS [What Code] Long; SELECT Co, Base FROM <YourTableName> WHERE Code = [What Code] ORDER BY Base ASC;
保存查询
调整后的功能
Option Explicit
'***********************
' changed posCode to Long
'***********************
Function FIncPercentile(ByVal posCode As Long, ByVal k As Single, ByVal tbl As String) As Variant
'***********************
' CREATE/USE Precompiled Parameter Query
' Create New Query called "qdfPrepMedian"
' Copy/Paste SQL >> PARAMETERS [What Code] Long; SELECT Co, Base FROM <YourTableName> WHERE Code = [What Code] ORDER BY Base ASC;
Const QRY_BY_CODES As String = "qdfPrepMedian"
Dim qdf As QueryDef
'
'***********************
Dim rstRec As Recordset
Dim db As Database
Dim n As Integer
Dim i As Single
' Declare all Currency variables on separate lines
' Otherwise they will be variants
Dim res As Currency
Dim d1 As Currency
Dim d2 As Currency
Set db = CurrentDb
'***********************
' Create readonly recordset from querydef
Set qdf = db.QueryDefs(QRY_BY_CODES)
qdf.Parameters("What Code") = posCode ' matches LONG variable passed to function
Set rstRec = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly) ' Readonly is sometimes faster
'***********************
' Use WITH rstRec
With rstRec
' Skip if there are no matches
If IsNull(!base) Or .RecordCount = 0 Then
'*** Is this a type ***
' FBasePercentile = Null
' Should it BE
FIncPercentile = Null
Exit Function
End If
' Count records
.MoveLast
n = .RecordCount
.MoveFirst
' Calculate the index where k is the percentile
i = n * k
' Test the decimal and find value accordingly
If i = Int(i) Then
.Move i - 1
d1 = !base
.MoveNext
d2 = !base
FIncPercentile = (d1 + d2) / 2
Else
i = Round(i + 0.5, 0)
.Move i - 1
FIncPercentile = !base
End If
End With
End Function