Function VBA pour Calcul d'un âge médian
Le
Statman
Je voudrais créer une fonction me permettant de calculer la médiane de donnée
(dans mon cas l'age médian)
Par exemple
Age Nombre d'individus
1 5
2 10
3 10
4 15
5 20
6 5
Étape 1 L'idée consiste à faire la somme cumulée du nombre d'individus
Age Nombre d'individus
1 5
2 15
3 25
4 40
5 60
6 65
Étape 2 Divisée par deux la somme donc dans ce cas 65/2 = 32,5
Donc l'âge médian se situe entre 3 et 4 ans il faut donc que le programme
puisse trouver la valeur inférieur à 32,5 et supérieur à 32,5 soit 25 et 40
et aussi de trouver l'âge correspondant afin soit 3 ans et 4 ans afin
d'intéger le tout dans une formule pour faire une interpolation
Étape 3 La formule d'interpolation est : Age inférieure (3 ans) + ((((demi
somme (32,5)) - (valeur inférieur (25)))/(((valeur supérieur (40)) - (valeur
inférieur (25))))
Je voudrais donc intégrer cette méthode dans un fonction VBA
(dans mon cas l'age médian)
Par exemple
Age Nombre d'individus
1 5
2 10
3 10
4 15
5 20
6 5
Étape 1 L'idée consiste à faire la somme cumulée du nombre d'individus
Age Nombre d'individus
1 5
2 15
3 25
4 40
5 60
6 65
Étape 2 Divisée par deux la somme donc dans ce cas 65/2 = 32,5
Donc l'âge médian se situe entre 3 et 4 ans il faut donc que le programme
puisse trouver la valeur inférieur à 32,5 et supérieur à 32,5 soit 25 et 40
et aussi de trouver l'âge correspondant afin soit 3 ans et 4 ans afin
d'intéger le tout dans une formule pour faire une interpolation
Étape 3 La formule d'interpolation est : Age inférieure (3 ans) + ((((demi
somme (32,5)) - (valeur inférieur (25)))/(((valeur supérieur (40)) - (valeur
inférieur (25))))
Je voudrais donc intégrer cette méthode dans un fonction VBA
Poser une question
Function AgeMedian(NombreIndividus As Range, Age As Range) As Double
Dim arr()
Dim i As Integer, Vi As Integer, Vs As Integer, Ai As Integer, somm As Integer
For i = 1 To NombreIndividus.Count
ReDim Preserve arr(i)
somm = somm + NombreIndividus.Item(i)
arr(i) = somm
Next
For i = 1 To NombreIndividus.Count
If arr(i) > somm / 2 Then
Vs = arr(i)
Vi = arr(i - 1)
Ai = Application.Index(Age, Application.Match(Vi, NombreIndividus))
Exit For
End If
Next
AgeMedian = Ai + (((somm / 2) - Vi) / (Vs - Vi))
End Function
isabelle
Function med(x As Variant, y As Variant) As Variant
Dim z() As Variant
nligne = x.Rows.Count
ReDim z(0 To nligne) As Variant
z(1) = y(1)
For i = 2 To nligne
z(i) = z(i - 1) + y(i)
Next i
Median = z(nligne) / 2
For i = 1 To nligne
If z(i) < Median Then
imin = i
End If
Next i
med = x(imin) + (Median - z(imin)) / (z(imin + 1) - z
(imin))
End Function
(pas de test)
Denis
' Usage : =Interpol(Ages,NbrIndividus)
Function InterPol(LesX As Range, LesY As Range) As Variant
Dim LaSommeY As Double
Dim res As Variant, Ycumul As Variant
Dim i As Long, j As Long
j = LesY.Rows.Count
ReDim Ycumul(1 To j) ' bâtir les montants cumulés
LaSommeY = 0
For i = 1 To j
Ycumul(i) = LaSommeY + LesY(i)
LaSommeY = Ycumul(i)
Next i
res = Application.Match(LaSommeY / 2, Ycumul)
If IsError(res) Then
InterPol = CVErr(xlErrNum)
Exit Function
Else
InterPol = LesX(res) + ((LaSommeY / 2 - Ycumul(res)) / _
(Ycumul(res + 1) - Ycumul(res)))
End If
Erase Ycumul
End Function
Salutations,
Daniel M.
"Statman" news:
il faut remplacer la ligne :
Ai = Application.Index(Age, Application.Match(Vi, NombreIndividus))
par
Ai = Age.Item(i - 1)
isabelle
Une autre version, mais sans boucle (pour le fun):
Function InterPol2(LesX As Range, LesY As Range) As Variant
Dim ValYMed As Double
Dim r As Variant, Ycumul As Variant
r = LesY.Address(0, 0, xlA1, 0)
Ycumul = Evaluate("=MMULT(TRANSPOSE(ROW(" & r & ")^0)," & r & _
"*(ROW(" & r & ")<=TRANSPOSE(ROW(" & r & "))))")
ValYMed = Ycumul(UBound(Ycumul)) / 2
r = Application.Match(ValYMed, Ycumul) ' rech dichotomique rapide
If IsError(r) Then ' ValYMed < Plus petite valeur
InterPol2 = (ValYMed) / Ycumul(1)
Else
InterPol2 = LesX(r) + ((ValYMed - Ycumul(r)) / _
(Ycumul(r + 1) - Ycumul(r)))
End If
Erase Ycumul
End Function
Salutations,
Daniel M.
"Daniel.M" news:e0PDE$