Créer une formule sur VB (macro) pour calculer une médiane

Bonjour,

Le calcul est assez facile. Ce qu'il faut savoir c'est comment tu vas passer les nombres à la fonction. Tu peux le faire soit en passant une série de nombres discrets soit en passant un tableau de nombres. Dans l'attente de ta réponse, je vais commencer le code avec l'hypothèse de la série de nombres discrets (auquel cas tu serais limité à 255 nombres).

Daniel

A tester, avec un tableau en entrée :

Function Mediane(ParamArray Tbl() As Variant) As Double
  Dim Arr() As Double
  ReDim Arr(UBound(Tbl(0)))
  For i = 0 To UBound(Tbl(0))
    Arr(i) = Tbl(0)(i)
  Next i
  QuickSortArray Arr
  nb = UBound(Tbl(0)) / 2
  If Int(nb) <> nb Then
    nb = nb + 0.5
  End If
  Mediane = Arr(nb)
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

La fonction "QuickSortArray" est une fonction que l'on trouve facilement sur internet. Je ne sais pas à qui en attribuer la paternité.

Pour tester la fonction :

Sub test1()
  Dim Tbl(2)
  Tbl(0) = 10
  Tbl(1) = 2
  Tbl(2) = 5
  MsgBox Mediane(Tbl)
End Sub

Avec une série de nombres, par exemple 2, 5, 10 :

Function Mediane2(n1, Optional n2, Optional n3, Optional n4, Optional n5) As Double
  Dim Arr() As Double
  Ctr = -1
  Ctr = Ctr + 1
  ReDim Preserve Arr(Ctr)
  Arr(Ctr) = n1
  If IsMissing(n2) = False Then
    Ctr = Ctr + 1
    ReDim Preserve Arr(Ctr)
    Arr(Ctr) = n2
  End If
  If IsMissing(n3) = False Then
    Ctr = Ctr + 1
    ReDim Preserve Arr(Ctr)
    Arr(Ctr) = n3
  End If
  If IsMissing(n4) = False Then
    Ctr = Ctr + 1
    ReDim Preserve Arr(Ctr)
    Arr(Ctr) = n4
  End If
  If IsMissing(n5) = False Then
    Ctr = Ctr + 1
    ReDim Preserve Arr(Ctr)
    Arr(Ctr) = n5
  End If
  QuickSortArray Arr
  nb = (UBound(Arr) + 1) / 2
  If Int(nb) <> nb Then
    nb = nb + 0.5
  End If
  Mediane2 = Arr(nb - 1)
End Function

Pour tester :

Sub test2()
  MsgBox Mediane2(10, 2, 5)
End Sub

Même fonction  QuickSortArray que dans le message précédent. La fonction ne peut traiter ici que 5 nombres maximum. La méthode par tableau du post précédent doit être privilégiée, celle-ci étant limitée à 255 nombres.