Discussion :

[cgalzin]

Bonjour,

J'ai une table qui s'appelle "LILCO" et qui comporte, entre autres, un champ "Cellules" (nombre) et un champ "Date".
Je ne connait pas bien le langage vba et sql et j'essaye désespérément de calculer une moyenne géométrique sur le champ "Cellules" mais je n'y arrive pas...
Exemple sur 3 résultats: Moyenne géométrique = (R1*R2*R3)^(1/3)

Quels sont les codes vba et SQL pour une telle fonction?

Merci d'avance pour votre aide !

[ClaudeLELOUP]

Bonjour, sois le bienvenu parmi nous,

Que veux-tu faire ? Calculer la moyenne de tous les "Cellules" de la table, quelle que soit la date ?

[cgalzin]

Merci pour la rapidité de votre réponse!

Dans un premier temps sur toutes les cellules.
Dans un second temps je suis également intéressé pour que ce calcul se fasse uniquement sur les enregistrement compris entre deux dates.

[ClaudeLELOUP]

Voici une fonction qui devrait faire l'affaire. Elle doit être logée dans un module.

Les dates doivent s'écrire sous la forme anglo-saxonne.

Pour tester, ouvre la fenêtre d'exécution <CTRL + G>, saisis :
? MoyGeo(#2/1/14#,#12/29/14#) + <Enter> pour la moyenne géométrique du 2 janvier au 29 décembre inclus

? MoyGeo() + <Enter> pour la moyenne géométrique de tous les enregistrements.

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
Option Compare Database
Option Explicit
 
 
Public Function MoyGeo(Optional DateDebut As Date, Optional DateFin As Date) As Double
    '    ? MoyGeo(#1/2/14#,#12/29/14#)  du 2 janvier au 29 décembre inclus
  Dim rst As Recordset
  Dim sSql As String
  Dim dProduit As Double
  Dim iNbre As Integer
  'Si les dates ne sont pas mentionnées, on les remplace par la plus petite et la plus grande présentes dans LILCO
  If DateDebut = #12:00:00 AM# Then DateDebut = DMin("Dates", "LILCO")
  If DateFin = #12:00:00 AM# Then DateFin = DMax("Dates", "LILCO")
  'Construire le SQL de la requête qui sélection la tranche d'enregistrements
  sSql = "SELECT Cellules, Dates FROM LILCO WHERE Dates>=#" & Format(DateDebut, "mm/dd/yy") & "# And Dates<=#" & Format(DateFin, "mm/dd/yy") & "#;"
  Set rst = CurrentDb.OpenRecordset(sSql)
  dProduit = 1
  'On lit les enregistrements un à un pour calculer le produit et le nbre d'élément
  Do While Not rst.EOF
    dProduit = dProduit * rst("Cellules")
    iNbre = iNbre + 1
    rst.MoveNext
  Loop
  'In fine, on calcule la moyenne géométrique
  MoyGeo = dProduit ^ (1 / iNbre)
  'Et on sort proprement
  rst.Close
  Set rst = Nothing
End Function

[cgalzin]

Claude,

Votre fonction marche à merveille!!!!! Merci infiniment!

J'ai également un champ dans la table LILCO qui se nomme "Codede"; J'aimerais calculer la moyenne géométrique en paramétrant les dates et en regroupant sur le champ "Codede" (voir pièce jointe). Le but est d'obtenir dans une requête un tableau du type:

Codede MoyGeo
19001001 MoyGeo1
19002002 MoyGeo2

[ClaudeLELOUP]

Humm ! Tu ne dis pas tout le même jour...

[ClaudeLELOUP]

Voici en quelque sorte un couteau suisse !

Cette fonction va te permettre d’obtenir la moyenne géométrique :
- de toute la table ;
- pour seulement un Codede éventuellement spécifié ;
- entre deux dates éventuellement spécifiées.
De plus une requête te permet d’obtenir une récap Codede par Codede.

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
Option Compare Database
Option Explicit
 
 
Public Function MoyGeo(Optional Codede As String, Optional DateDebut As Date, Optional DateFin As Date) As Double
    '    ? MoyGeo("19001001",#1/2/14#,#12/29/14#)  pour le Codede 19001001 du 2 janvier au 29 décembre inclus
    '    ? MoyGeo(,#1/2/14#,#12/29/14#)  pour tous les Codede du 2 janvier au 29 décembre inclus
    '    ? MoyGeo(,,#12/29/14#)  pour tous les Codede depuis le début jusqu'au 29 décembre inclus
    '    ? MoyGeo(,#1/2/14#)  pour tous les Codede du 2 janvier jusqu'à la fin incluse
    '    ? MoyGeo()  pour toute la table
    '    ? moygeo("19001001") pour le Codede 19001001 quelle que soit la date
  On Error GoTo GestionErreurs
  Dim rst As Recordset
  Dim sSql As String
  Dim dProduit As Double
  Dim iNbre As Integer
  'Si les dates ne sont pas mentionnées, on les remplace respectivement
  '                               par la plus petite et la plus grande présentes dans LILCO
  If DateDebut = #12:00:00 AM# Then DateDebut = DMin("Dates", "LILCO")
  If DateFin = #12:00:00 AM# Then DateFin = DMax("Dates", "LILCO")
  'Construire le SQL de la requête qui sélection la tranche d'enregistrements
                                                  'selon que Codede est présent ou pas
  If Codede = "" Then 'ex ? MoyGeo(,#1/2/14#,#12/29/14#)
      sSql = "SELECT Cellules, Dates FROM LILCO WHERE Dates>=#" & Format(DateDebut, "mm/dd/yy") _
                 & "# And Dates<=#" & Format(DateFin, "mm/dd/yy") & "#;"
    Else 'ex ? MoyGeo("19001001",#1/2/14#,#12/29/14#)
      sSql = "SELECT Cellules, Dates FROM LILCO WHERE Dates>=#" & Format(DateDebut, "mm/dd/yy") _
                 & "# And Dates<=#" & Format(DateFin, "mm/dd/yy") & "# AND Codede=""" & Codede & """;"
  End If
  dProduit = 1
  'On lit les enregistrements un à un pour calculer le produit et le nbre d'élément
  Set rst = CurrentDb.OpenRecordset(sSql)
  Do While Not rst.EOF
    dProduit = dProduit * rst("Cellules")
    iNbre = iNbre + 1
    rst.MoveNext
  Loop
  'In fine, on calcule la moyenne géométrique
  MoyGeo = dProduit ^ (1 / iNbre)  'Cette instruction va lever une erreur N° 11 si iNbre=0
Sortir:
  'Et on sort proprement
  rst.Close
  Set rst = Nothing
  Exit Function
GestionErreurs:
  Select Case Err.Number
    Case 11  'on essaie de diviser par zéro
      MsgBox "Il n'y a pas d'enregistrement pour le Codede " & Codede & " pour la période !"
      MoyGeo = 0
      GoTo Sortir
    Case Else
      MsgBox "Erreur N°" & Err.Number & " " & Err.Description & " dans MoyGeo()."
      MoyGeo = 0
      GoTo Sortir
  End Select
End Function

Et voici la requête :



qui, pour la période de 1er janvier au 31 décembre 2014, rendra ceci :




Attention, à l’invite de saisie des paramètres, il faut saisir la date à l’européenne sans l’encadrer de croisillons ! Comme ceci :




La db exemple est ici : http://claudeleloup.developpez.com/F...424cgalzin.mdb

[cgalzin]

Claude vous êtes génial!!!!!!!!

C'est exactement ce dont j'avais besoin! En plus avec les commentaires votre code est trés pédagogique et aide à comprendre le langage.
Cette fonction va me faire gagner beaucoup de temps et je crois que je ne vous remercierai jamais assez du service que vous m'avez rendu!

Un grand merci encore une fois!!!

Bonne journée!