Fonctions PourcentileDom et MedianeDom [Sources]

[philben]

Bonjour,

j'avais écrit une fonction qui renvoie la médiane d'un domaine (table ou requête). En extrapolant, je vous propose la fonction <PourcentileDom> qui renvoie la valeur correspondant au x-ième pourcentile.

Pour de plus amples explications, voir le code-source.

Toute remarque ou suggestion est bienvenue.

Code :

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
 
' Renvoie la médiane d'une distribution (voir la fonction PourcentileDom pour + d'infos)
Public Function MedianeDom(ByVal sExpression As String, _
                           ByVal sDomaine As String, _
                           Optional ByVal sCritere As String = vbNullString, _
                           Optional ByVal bNullAsZero As Boolean = False, _
                           Optional ByVal bMsgBoxErr As Boolean = True) As Single
   MedianeDom = PourcentileDom(50, sExpression, sDomaine, sCritere, bNullAsZero, bMsgBoxErr)
End Function
 
'************************************************************************************************
'* Fonction    : PourcentileDom
'* Auteur      : PhilBen (© dans le cas d'un usage professionnel)
'* Version     : 1.0
'* Publication : 22/07/2006 (www.developpez.com)
'* Dépendances : PourcentileDom -> IsStatDomErr -> StatExpressionErr
'* Objet       : Renvoie le x-ième pourcentile des valeurs d'une distribution.
'*               Le plus connu des pourcentiles est la médiane ou 2ème quartile (50e pourcentile)
'*               qui est la valeur correspondante à la position centrale de la distribution.
'*               Permet par exemple de définir un seuil d'acceptation ou de sélection de valeurs.
'* Remarques   : - La valeur numérique retournée peut être interpolée si le pourcentile
'*                 demandé ne correspond pas un enregistrement du domaine étudié.
'*               - Le 1er quartile correspond à un pourcentile de 25, le 3ème à 75.
'* Paramètres  : - dPourcentile : Valeur (type Double) du pourcentile demandé [0,0% à 100,0%]
'*               - sExpression  : Identifiant obligatoire de la distribution étudiée
'*               - sDomaine     : Identifiant obligatoire du nom de la table ou de la requête
'*                                qui porte les enregistrements du domaine étudié;
'*               - sCritere     : Expression facultative permettant de restreindre l'étendue
'*                                du domaine étudié (équivalent à l'argument de la clause WHERE
'*                                d'une requête SQL)
'*               - bNullAsZero  : Indique si la fonction doit considérer les valeurs nulles
'*                                comme égales à zéro (True) ou si elle n'en tient pas compte
'*                                (False, par défaut)
'*               - bMsgBoxErr   : Valeur boléenne facultative (Vrai par défaut) indiquant
'*                                si la fonction affiche ou non un message en cas d'erreur
'* Retour      : Renvoie la valeur (type Single) du pourcentile demandé
'* Exemple     : MsgBox PourcentileDom(95.0, "MonChampEtudié", "NomDeMaTable")
'************************************************************************************************
Public Function PourcentileDom(ByVal dPourcentile As Double, ByVal sExpression As String, _
                              ByVal sDomaine As String, Optional ByVal sCritere As String = vbNullString, _
                              Optional ByVal bNullAsZero As Boolean = False, _
                              Optional ByVal bMsgBoxErr As Boolean = True) As Single
On Error GoTo PCDErr
   Dim oDb As DAO.Database
   Dim oRs As DAO.Recordset
   Dim dPosition As Double, dRatio As Double, dResult As Double
   Dim sSql As String, sTmpCrit As String, sMsgErr As String
 
   If Not IsStatDomErr(sMsgErr, "Pourcentile", sDomaine, sExpression) Then
      If dPourcentile < 0 Or dPourcentile > 100 Then
         sMsgErr = "Le <Pourcentile> doit être dans l'intervalle [0,0% à 100,0%]..."
         GoTo fin
      End If
 
      sSql = "SELECT " & sExpression & " FROM " & sDomaine
 
      sCritere = Trim$(sCritere)
      If Not bNullAsZero Then
         sTmpCrit = "(" & sExpression & ") Is Not Null"
         sCritere = IIf(Len(sCritere) > 0, sCritere & " AND " & sTmpCrit, sTmpCrit)
      End If
      If Len(sCritere) > 0 Then
         sSql = sSql & " WHERE " & sCritere
      End If
      sSql = sSql & " ORDER BY " & sExpression & ";"
 
      Set oDb = CurrentDb
      Set oRs = oDb.OpenRecordset(sSql, dbOpenSnapshot)
 
      If Not oRs.EOF Then
         Select Case oRs.Fields(0).Type
            Case dbByte, dbInteger, dbLong, dbFloat, dbSingle, dbDouble
               oRs.MoveLast 'Nécessaire pour le calcul de RecordCount
               If oRs.RecordCount > 1 Then
                  dPosition = dPourcentile * (oRs.RecordCount - 1) / 100
                  dRatio = dPosition - Int(dPosition)
 
                  oRs.Move (Int(dPosition) - oRs.RecordCount + 1)
                  dResult = Nz(oRs.Fields(0))
                  If dRatio > 0 Then
                     oRs.MoveNext
                     dResult = dResult + (Nz(oRs.Fields(0)) - dResult) * dRatio
                  End If
                  PourcentileDom = dResult
               Else
                  PourcentileDom = Nz(oRs.Fields(0))
               End If
            Case Else
               sMsgErr = "<Expression> doit retourner une valeur numérique..."
         End Select
      Else
         sMsgErr = "Aucun enregistrement retourné par le domaine..."
      End If
   End If
fin:
   Set oRs = Nothing
   Set oDb = Nothing
   If bMsgBoxErr And Len(sMsgErr) > 0 Then
      MsgBox sMsgErr, vbExclamation, "PourcentileDom"
   End If
   Exit Function
PCDErr:
   sMsgErr = "Erreur n°" & Err.Number & vbCrLf & "Description :" & Err.Description
   Resume fin
End Function
 
' Vérifie sommairement les paramètres de la fonction de statistiques
Private Function IsStatDomErr(sMsgErr As String, sNomFunc As String, _
                              sDomaine As String, sExpression1 As String, _
                              Optional sExpression2 As String = vbNullString) As Boolean
   sMsgErr = vbNullString
   If Len(Trim$(sDomaine)) = 0 Then
      sMsgErr = "<Domaine> ne peut être vide..."
   Else
      sMsgErr = StatExpressionErr(sNomFunc, Trim$(sExpression1))
      If Len(sMsgErr) = 0 And sExpression2 <> vbNullString Then
         sMsgErr = StatExpressionErr(sNomFunc, Trim$(sExpression2))
      End If
   End If
   If Len(sMsgErr) > 0 Then IsStatDomErr = True
End Function
 
' Vérifie sommairement les expressions
Private Function StatExpressionErr(sNomFunc As String, sExpression As String) As String
   If Len(sExpression) = 0 Then
      StatExpressionErr = "<Expression> ne peut être vide..."
   ElseIf sExpression = "*" Or InStr(1, sExpression, ".*", vbBinaryCompare) > 0 Then
      StatExpressionErr = "Le " & sNomFunc & " ne peut être calculé sur l'ensemble des colonnes (*)..."
   ElseIf InStr(1, sExpression, ",", vbBinaryCompare) > 0 Then
      StatExpressionErr = "<Expression> ne doit pas retourner plus d'un champ..."
   ElseIf InStr(1, sExpression, " AS ", vbTextCompare) > 0 Then
      StatExpressionErr = "Le champ de <Expression> ne doit pas être aliasé..."
   End If
End Function

Philippe

[benharom]

Philippe,

J'ai intégré la fonction médiane dans ma Base Access (v.2000). mais lorsque je calcule la mediane d'un champ numérique via une requête, access me renvoie une table avec des erreurs. Je ne comprend pas trop pourquoi, pourrez-tu m'aider STP?

Rhum1

[philben]

bonjour,

je ne vois pas pourquoi, essayer le fonction de Tofalu http://access.developpez.com/sources/?page=Conv#Mediane pour voir si c'est pareil ou non ?

Cordialement,

Philippe

[benharom]

C'est exactement la même chose

[philben]

bonjour,

bon, l'erreur est ailleurs...

Comment appelez-vous la fonction dans le code VBA ?
Quelle est la requête ?
qu'est-ce qu'une table avec des erreurs ?

la fonction ne doit pas être appelée dans une requête et pour l'utiliser, il faut référencer tout d'abord DAO...

Cordialement,

Philippe

[benharom]

J explique plus en details mon problème : pour un observatoire de l immobiler je dois calculer la mediane des prix de loyer, de vente etc... pour un departement mais aussi pour chaque commune.

J ai donc repris le code vb de ce poste et je l ai integrer dans un module appelé fctmediane. La fonction est appelé MedianeDom.

Ensuite pour calculer la mediane de mon champ, j'ai utilisé l'assistant requeteur de Access et dans Creer j'ai été chercher la fonction que je venais d'integrer dans le module en integrant les différents paramètres de la fonction (table, champ,...) . Lorsque j'execute la requete il ne trouve pas ma table nommée ANNONCES. En effet, il y a une boîte de dialogue qui s'affiche avec Entrer la valeur du paramètre.

Si je clique sur entrer : le resultat de la requete me renvoie le mot erreur sur autant d'entité que ma table!!

Peur être que ma table n'est pas référencée DAO? mais ça veut dire quoi?

Rhum1

[philben]

bonjour,

je vois a priori 2 problèmes :

1) Vérifier que la librairie DAO est bien activée dans Visuel Basic Editor
Dans Visual basic editor, cliquer sur le menu <outils> puis <références>.
Vérifier que <Microsoft DAO 3.X object library> est coché, sinon le faire

2) j'ai l'impression que vous appelez la fonction <MedianeDom> depuis votre requête, ce qu'il ne faut pas faire sauf cas particulier.
Il faut appeler cette fonction depuis VBA ou depuis un contrôle de formulaire ou d'état.

Me trompe-je ?

A+

Philippe