I have a query that the boss needs to find a median. I have searched the forum and found some things but have not worked.
I found this but it errors out on Set rst = db.OpenRecordset(strSQL)
Thank You for any help.
Jim Wagner
Function DMedian(strFieldName As String, strDomainName As String, _
Optional varWhere As Variant) As Variant
' Function to calculate the Median numeric value of a column in a domain
' Input: Name of the field, Name of the domain, Predicate (optional) - all
strings
' Output: Median numeric value or Null if the field is a string or error
encountered
Dim db As DAO.Database, rst As DAO.Recordset
Dim strSQL As String, lngRecords As Long, intVarType As Integer
Dim varValue As Variant, lngRows As Long, strWhere As String
'On Error GoTo DMedianBail
' Set default return of Null
DMedian = Null
' Check for possible "missing" third argument
If Not IsMissing(varWhere) Then
If varType(varWhere) = vbString Then strWhere = varWhere
End If
' Point to the current database
Set db = DBEngine.Workspaces(0).Databases(0)
' Open the domain sorted by the field
strSQL = "SELECT [" & strFieldName & "] FROM [" & strDomainName & "]"
If Len(strWhere) <> 0 Then
strSQL = strSQL & " WHERE " & strWhere
End If
strSQL = strSQL & " Order By [" & strFieldName & "];"
Set rst = db.OpenRecordset(strSQL)
' If no rows, then return Null
If rst.EOF Then
rst.Close
Exit Function
End If
' Get the number of rows
rst.MoveLast
lngRecords = rst.RecordCount
rst.MoveFirst
intVarType = varType(rst(strFieldName))
' If the data type of the field isn't a number, then return Null
If intVarType < 2 Or intVarType > 7 Then
rst.Close
Exit Function
End If
' Calculate the "middle" of the recordset
lngRows = lngRecords \ 2
' If an even number, then do an average
If lngRecords Mod 2 = 0 Then
rst.Move lngRows - 1
varValue = rst(strFieldName)
rst.MoveNext
varValue = (varValue + rst(strFieldName)) / 2
Else
rst.Move lngRows
varValue = rst(strFieldName)
End If
DMedian = varValue
' Be sure to return the proper data type
Select Case intVarType
Case vbInteger
DMedian = CInt(varValue)
Case vbLong
DMedian = CLng(varValue)
Case vbSingle
DMedian = CSng(varValue)
Case vbDouble
DMedian = CDbl(varValue)
Case vbCurrency
DMedian = CCur(varValue)
Case vbDate
DMedian = CDate(varValue)
End Select
rst.Close
DMedianBail:
Exit Function
End Function
Optional varWhere As Variant) As Variant
' Function to calculate the Median numeric value of a column in a domain
' Input: Name of the field, Name of the domain, Predicate (optional) - all
strings
' Output: Median numeric value or Null if the field is a string or error
encountered
Dim db As DAO.Database, rst As DAO.Recordset
Dim strSQL As String, lngRecords As Long, intVarType As Integer
Dim varValue As Variant, lngRows As Long, strWhere As String
'On Error GoTo DMedianBail
' Set default return of Null
DMedian = Null
' Check for possible "missing" third argument
If Not IsMissing(varWhere) Then
If varType(varWhere) = vbString Then strWhere = varWhere
End If
' Point to the current database
Set db = DBEngine.Workspaces(0).Databases(0)
' Open the domain sorted by the field
strSQL = "SELECT [" & strFieldName & "] FROM [" & strDomainName & "]"
If Len(strWhere) <> 0 Then
strSQL = strSQL & " WHERE " & strWhere
End If
strSQL = strSQL & " Order By [" & strFieldName & "];"
Set rst = db.OpenRecordset(strSQL)
' If no rows, then return Null
If rst.EOF Then
rst.Close
Exit Function
End If
' Get the number of rows
rst.MoveLast
lngRecords = rst.RecordCount
rst.MoveFirst
intVarType = varType(rst(strFieldName))
' If the data type of the field isn't a number, then return Null
If intVarType < 2 Or intVarType > 7 Then
rst.Close
Exit Function
End If
' Calculate the "middle" of the recordset
lngRows = lngRecords \ 2
' If an even number, then do an average
If lngRecords Mod 2 = 0 Then
rst.Move lngRows - 1
varValue = rst(strFieldName)
rst.MoveNext
varValue = (varValue + rst(strFieldName)) / 2
Else
rst.Move lngRows
varValue = rst(strFieldName)
End If
DMedian = varValue
' Be sure to return the proper data type
Select Case intVarType
Case vbInteger
DMedian = CInt(varValue)
Case vbLong
DMedian = CLng(varValue)
Case vbSingle
DMedian = CSng(varValue)
Case vbDouble
DMedian = CDbl(varValue)
Case vbCurrency
DMedian = CCur(varValue)
Case vbDate
DMedian = CDate(varValue)
End Select
rst.Close
DMedianBail:
Exit Function
End Function
Jim Wagner
__._,_.___
Posted by: Jim Wagner <luvmymelody@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (1) |
.
__,_._,___
Tidak ada komentar:
Posting Komentar