calcul de MEDIANE

Bonjour.

il existe en vba une fonction à partir d'un tableau, je te la donne je ne
l'ai jamais testée ni utilisée. sous toute réserve.

Function Median(ParamArray avarValues() As Variant) As Double
' Renvoie la médiane d'un ensemble de nombres.
Dim lngCount As Long
Dim varTemp As Variant
' Enregistre le tableau dans une variable termporaire.
varTemp = avarValues()
' Vérifie si le tableau est numérique.
If IsNumericArray(varTemp) Then
' Détermine le nombre d'éléments du tableau.
lngCount = UBound(varTemp) - LBound(varTemp) + 1
' Trie le tableau.
QuickSortArray varTemp
' Détermine si le tableau contient un nombre d'éléments pair ou
impair.
If IsEven(lngCount) Then
' En cas de nombre pair, il est nécessaire de trouver les
éléments du milieu
' et de renvoyer la moyenne de leurs valeurs.
' Souvenez-vous que nous travaillons avec un tableau en base
zéro !
Median = (varTemp(lngCount / 2 - 1) + varTemp(lngCount / 2)) / 2
Else
' En cas de nombre impair, il est nécessaire de trouver
l'élément du milieu.
Median = varTemp(Int(lngCount / 2))
End If
Else
' Renvoie -1 si le tableau n'est pas numérique.
Median = -1
End If
End Function

Function IsNumericArray(avarValues As Variant) As Boolean
' Traite un tableau de variantes, et renvoie True si tous les éléments
sont numériques.
Dim lngIndex As Long

' Vérifie chaque élément pour s'assurer qu'il est numérique.
For lngIndex = LBound(avarValues) To UBound(avarValues)
If Not IsNumeric(avarValues(lngIndex)) Then
' Si aucun élément n'est numérique, renvoie False et quitte.
IsNumericArray = False
GoTo IsNumericArray_End
End If
Next
IsNumericArray = True

IsNumericArray_End:
Exit Function

End Function
Function QuickSortArray(avarArrFiles As Variant, _
Optional intFirst As Integer = -1, _
Optional intLast As Integer = -1) As Variant
' Algorithme QuickSort utilisé pour trier les fichiers
' du tableau avarArrFiles.
Dim intLow As Integer
Dim intHigh As Integer
Dim intMiddle As Integer
Dim varTempVal As Variant
Dim varTestVal As Variant

If intFirst = -1 Then intFirst = LBound(avarArrFiles)
If intLast = -1 Then intLast = UBound(avarArrFiles)

If intFirst < intLast Then
intMiddle = (intFirst + intLast) / 2
varTestVal = avarArrFiles(intMiddle)
intLow = intFirst
intHigh = intLast
Do
Do While avarArrFiles(intLow) < varTestVal
intLow = intLow + 1
Loop
Do While avarArrFiles(intHigh) > varTestVal
intHigh = intHigh - 1
Loop
If (intLow <= intHigh) Then
varTempVal = avarArrFiles(intLow)
avarArrFiles(intLow) = avarArrFiles(intHigh)
avarArrFiles(intHigh) = varTempVal
intLow = intLow + 1
intHigh = intHigh - 1
End If
Loop While (intLow <= intHigh)
If intFirst < intHigh Then QuickSortArray avarArrFiles, intFirst,
intHigh
If intLow < intLast Then QuickSortArray avarArrFiles, intLow,
intLast
End If
End Function

Function IsEven(lngNum As Long) As Boolean
' Détermine si un nombre est pair ou impair.

IsEven = Not CBool(lngNum Mod 2)
End Function


--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum


"Alex" <afranc@cirad.fr> a écrit dans le message de
news:66c001c42e96$086c64b0$a601280a@phx.gbl...

Est ce que c'est possible de calculer des Medianes dans une
requete ?
En tout cas la fonction n'existe pas dans la liste predefinie.

Peut on creeer de nouvelles fonctions manuellement (VBA ou
SQL).
merci
Alex.