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 |
Partager