Discussion :

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[francescodelapampa]

Bonjour à tous ,

Je suis novice sur ACCESS et je rencontre des difficultés pour calculer les "percentile". voilà plusieurs jours que j'essaie de résoudre mon problème mais malgré ma bonne volonté je sèche. Je vous remercie de votre appui et je vous prie de m'excuser pour le faible niveau de mes questions.

J'ai une table IMPORT qui me permet de récupérer des données individuelles (sexe, ancienneté, niveau, salaire, ...) par entité. Il y a donc une table par entité.


1) Sur la structure de la table
Vaut-il mieux que j'ai un fichier par entité et par année (exemple Brésil 2016, Lituanie 2016, Lituanie 2017,Brésil 2017) ou un fichier par année qui regroupe les entités (2016 qui regroupe Lituanie et Brésil, 2017 qui regroupe Lituanie et Brésil).

D'un point de vue pratique je ferais des comparaisons au sein d'une même entité d'une année sur l'autre (exemple évolution entre 2016 et 2017 des hommes), et des comparaisons la même année entre différentes entités.

2) Sur les calculs à proprement parler
Je souhaiterais calculer suivant un à trois critères issus des champs de la table IMPORT (âge,sexe, ancienneté, niveau, ...) le D1 (1er décile), le Q1 (premier quartile), le Q2 (médiane), le Q3 (le 3ème quartile), le D9 (9ème décile) et la moyenne des salaires et l'enregistrer dans une deuxième table appelée STATS.

J'ai trouvé ce topic et ce sujet mais je ne suis pas sûr que cela corresponde à mon besoin et je ne sais pas comment appeler la fonction. J'ai trouvé d'autres fonctions qui ne me semblent pas correspondre non plus, mais que j'ai enregistrées.

Merci par avance pour votre aide.
François

[philben]

Bonsoir,

concernant l'utilisation de PourcentileDom, il faut utiliser cette mise à jour du code VBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
135
136
137
138
139
140
141
142
143
144
 
Option Compare Database
Option Explicit
 
 
' 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 Double
   MedianeDom = fPourcentileDom(50, sExpression, sDomaine, sCritere, bNullAsZero, bMsgBoxErr)
End Function
 
 
 
'************************************************************************************************
'* Fonction    : fPourcentileDom
'* Auteur      : PhilBen
'* Version     : 1.01
'* Publication : 22/07/2006 (www.developpez.com)
'* Dépendances : fPourcentileDom -> 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 Double) du pourcentile demandé
'* Exemple     : MsgBox PourcentileDom(95.0, "MonChampEtudié", "NomDeMaTable")
'************************************************************************************************
Public Function fPourcentileDom(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 Double
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
 
      If Not sExpression Like "[[]*[]]" Then sExpression = "[" & Trim$(sExpression) & "]"
      If Not sDomaine Like "[[]*[]]" Then sDomaine = "[" & Trim$(sDomaine) & "]"
 
 
      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
                  fPourcentileDom = dResult
               Else
                  fPourcentileDom = 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, "fPourcentileDom"
   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

ensuite la requête suivante calcule la médiane, Q1 et Q3 des salaires de la table import :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
SELECT medianedom("salaire de base","import") AS med, fpourcentileDom(25,"salaire de base","import") AS q1, fpourcentileDom(75,"salaire de base","import") AS q3;

Philippe