1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
| Public Function DMedian( _
ByVal strField As String, ByVal strdomain As String, _
Optional ByVal strcriteria As String) As Variant
' Purpose:
' To calculate the median value
' for a field in a table or query.
' In:
' strField: the field.
' strDomain: the table or query.
' strCriteria: an optional WHERE clause to
' apply to the table or query.
' Out:
' Return value: the median, if successful;
' Otherwise, an Error value.
Dim db As DAO.Database
Dim rstDomain As DAO.Recordset
Dim strsql As String
Dim varmedian As Variant
Dim intFieldType As Integer
Dim intRecords As Integer
Const errAppTypeError = 3169
On Error GoTo HandleErr
Set db = CurrentDb()
' Initialize return value.
varmedian = Null
' Build SQL string for recordset.
strsql = "SELECT " & strField & " FROM " & strdomain
' Only use a WHERE clause if one is passed in.
If Len(strcriteria) > 0 Then
strsql = strsql & " WHERE " & strcriteria
End If
strsql = strsql & " ORDER BY " & strField
Set rstDomain = db.OpenRecordset(strsql, dbOpenSnapshot)
' Check the data type of the median field.
intFieldType = rstDomain.Fields(strField).Type
Select Case intFieldType
Case dbByte, dbInteger, dbLong, _
dbCurrency, dbSingle, dbDouble, dbDate
' Numeric field.
If Not rstDomain.EOF Then
rstDomain.MoveLast
intRecords = rstDomain.RecordCount
' Start from the first record.
rstDomain.MoveFirst
If (intRecords Mod 2) = 0 Then
' Even number of records.
' No middle record, so move to the
' record right before the middle.
rstDomain.Move ((intRecords \ 2) - 1)
varmedian = rstDomain.Fields(strField)
' Now move to the next record, the
' one right after the middle.
rstDomain.MoveNext
' And average the two values.
varmedian = _
(varmedian + rstDomain.Fields(strField)) / 2
' Make sure you return a date, even when
' averaging two dates.
If intFieldType = dbDate And Not IsNull(varmedian) Then
varmedian = CDate(varmedian)
End If
Else
' Odd number or records.
' Move to the middle record and return its value.
rstDomain.Move ((intRecords \ 2))
varmedian = rstDomain.Fields(strField)
End If
Else
' No records; return Null.
varmedian = Null
End If
Case Else
' Non-numeric field; so raise an app error.
Err.Raise errAppTypeError
End Select
DMedian = varmedian
ExitHere:
On Error Resume Next
rstDomain.Close
Set rstDomain = Nothing
Exit Function
HandleErr:
' Return an error value.
DMedian = CVErr(Err.Number)
Resume ExitHere
End Function |
Mediane Access - Erreur 3071 Formule trop complexe pour être évaluée
Répondre avec citation
Envoyé par loufab
Partager