Function un peu spéciale ?

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

lebarbo

XLDnaute Occasionnel
Bonjour le forum, bonjour à tous,

Je souhaite faire une fonction sur ce qu'on appelle la tracking error dans le langage financier c'est à dire :
1/ J'ai deux séries de nombre

2/ Je dois calculer la rentabilité périodique de chacune des deux séries (c'est à dire [n/n-1]-1 ; [n+1/n]-1...)

3/ Je dois faire la différence entre chaque rentabilité périodique ce qui me donne la série ultime "u" ; )

exemple série n & série o

[n/n-1]-1 - [o/o-1] - 1 = u
[n+1/n]-1 - [o+1/o] - 1 = u1...

4/ Je fais un ecart type de cette série que je multiplie par la racine du "pas" de calcul (52 pour une série de rentabilité périodique.

Voilà ce que je souhaiterais faire dans une function mais j'ai franchement du mal avec le point 3/ où je dois faire un tableau virtuel dans la tête de "Monsieur VBA" si vous avez des idées...

Voilà mon premier bout de code :

Function Tracking_Error(PlageFonds As Range, PlageIndice As Range, Pas As Range)

NbLignesFonds = PlageFonds.Rows.Count
NbLIgnesIndice = PlageIndice.Rows.Count

ReDim Difference(2 To NbLignesFonds)

'calcul de la différence des rentabilités

For I = 2 To NbLignesFonds
Difference(I) = (PlageFonds.Cells(I, 1).Value / PlageFonds.Cells(I - 1, 1).Value - 1) - (PlageIndice.Cells(I, 1).Value / PlageIndice.Cells(I, 1).Value - 1)
Next I

Tracking_Error = Application.WorksheetFunction.StDev(Difference(I)) * Application.WorksheetFunction.SQRT(Pas)

End Function

Merci d'avance pour vos suggestions
 
Re : Function un peu spéciale ?

Merci GI_GI mais en fait le petit soucis c'est que tu te sers de la feuille Excel pour calculer et "mettre en mémoire" la série finale puis faire un Ecart type.
Il faudrait faire la même chose mais sans inscrire et sans "utiliser" le tableau Excel pour calculer la série finale.
Comme je le mentionne dans mon premier post je dois :
"faire un tableau virtuel dans la tête de "Monsieur VBA" qui correspondrait à cette série puis faire un ecart type de cette série.

Merci quand même et si t'as d'autres idées je suis preneur.
 
Re : Function un peu spéciale ?

Tout simplement parce que je veux en faire une fonction personnalisée dans Excel et pouvoir calculer le plus rapidement possible ce ratio en selectionnant mes deux séries.

Il me semblait que c'était possible dans VBA avec la fonction ReDim mais je ne suis pas du tout sur.
 
Re : Function un peu spéciale ?

Bonsoir lebarbo, Marc77, GI_GI,

Peut-être une solution (sans trop jouer avec les tableaux) :
Code:
[SIZE=2][COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD (MODULE1 PAR EXEMPLE)[/I][/B][/COLOR]

[COLOR=NAVY]Function[/COLOR] TrackErr(R1 [COLOR=NAVY]As[/COLOR] Range, R2 [COLOR=NAVY]As[/COLOR] Range) [COLOR=NAVY]As Double[/COLOR]
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] TabResult [COLOR=NAVY]As Variant
Dim[/COLOR] L [COLOR=NAVY]As Long[/COLOR]
    [COLOR=NAVY]If[/COLOR] R1.Count <> R2.Count [COLOR=NAVY]Then[/COLOR]
        MsgBox "Les 2 plages doivent être de même longueur !"
        [COLOR=NAVY]Exit Function
    End If
    ReDim[/COLOR] TabResult(1 [COLOR=NAVY]To[/COLOR] R1.Count - 1)
    [COLOR=NAVY]For[/COLOR] L = 2 [COLOR=NAVY]To[/COLOR] R1.Count
        TabResult(L - 1) = (R1(L).Value / R1(L - 1).Value) - (R2(L).Value / R2(L - 1).Value) - 2
    [COLOR=NAVY]Next[/COLOR] L
    TrackErr = Application.StDev(TabResult) * Sqr(52)
[COLOR=NAVY]End Function[/COLOR][/SIZE]
On peut appeler cette fonction depuis une cellule de la feuille comme suit (avec les 2 plages choisies comme arguments) :
=TrackErr(A2:A7;C2:C7)

Peut-être subsiste-t'il un léger problème d'arrondi... à voir.

Cordialement,
 
Dernière édition:
Re : Function un peu spéciale ?

Très très bon !!! Merci myDearFriend !!
Donc il y avait bien une histoire de ReDim ; )
Sinon pour le message d'erreur très bonne idée j'y avait pensé mais je ne l'avais pas encore mis en application, malheureusement il y a un petit bug : quand on sélectionne la 2ème série avec la souris, ça met le message d'erreur dès qu'on clique sur la première cellule car "il" croit qu'on a fini la selection.
Je ne vois pas comment l'améliorer ?

Petite question de code : le "-2" à la fin de
TabResult(L - 1) = (R1(L).Value / R1(L - 1).Value) - (R2(L).Value / R2(L - 1).Value) - 2
ça sert à quoi ?

Merci encore
 
Dernière édition:
Re : Function un peu spéciale ?

Bonsoir lebarbo, Marc77, GI_GI, le Forum,

Lebarbo à dit:
Petite question de code : le "-2" à la fin de
TabResult(L - 1) = (R1(L).Value / R1(L - 1).Value) - (R2(L).Value / R2(L - 1).Value) - 2
ça sert à quoi ?
Arf, à vrai dire, de nous deux, je pensais que c'étais toi le matheux...
Code:
[SIZE=2]TabResult(L - 1) = (R1(L).Value / R1(L - 1).Value) - (R2(L).Value / R2(L - 1).Value) [COLOR=RED][B]- 2[/B][/COLOR][/SIZE]
n'est que la simplification (très légère) de :
Code:
[SIZE=2]TabResult(L - 1) = (R1(L).Value / R1(L - 1).Value [COLOR=RED][B]- 1[/B][/COLOR]) - (R2(L).Value / R2(L - 1).Value[COLOR=RED][B] - 1[/B][/COLOR]) [/SIZE]
comme exprimé dans ta propre formule plus haut dans ce fil.

__________________________________​
Lebarbo à dit:
malheureusement il y a un petit bug : quand on sélectionne la 2ème série avec la souris, ça met le message d'erreur dès qu'on clique sur la première cellule car "il" croit qu'on a fini la selection.
Je ne vois pas comment l'améliorer ?
Je pense qu'il faudrait que tu m'expliques comment tu t'y prends pour saisir cette formule car je n'ai aucun souci de ce genre pour ma part...

Pour info, dans la cellule :
  • je saisis trackerr(
  • puis, je sélectionne la première série
  • puis, je tape le ;
  • puis je sélectionne la deuxième série
  • et enfin, je saisis la ) et je valide par Entrée.
(Plutôt que saisir le ; on peut aussi maintenir la touche CTRL et sélectionner la deuxième série dans la foulée)
A aucun moment la formule n'est validée avant la fin de sa saisie, par conséquent, le code correspondant ne peut agir...

Cordialement,
 
Re : Function un peu spéciale ?

Ok, bon il y a un petit soucis de parenthèse dans ma formule ; ) autant pour moi :

exemple précédent :
[n/n-1]-1 - [o/o-1] - 1 = u

doit en fait s'écrire :
[n/(n-1)-1] - [o/(o-1)-1] = u

donc la simplification nous donne :
[n/(n-1)] - [o/(o-1)] = u

Désolé pour cette erreur de parenthèse du coup j'étais un peu à l'ouest sur ce "-2"

Pour le souci de msgbox en effet avec ta façon c'est bon, en fait de mon côté je faisais apparaître l'"aide" de la formule en cliquant sur "fx" et en allant chercher la formule. En procédant de cette façon tu as les deux champs à remplir avec le petit bug...
Test, tu verras ce que ça donne et on en rediscute ensemble.

Merci
 
Re : Function un peu spéciale ?

Re lebarbo, Marc77, GI_GI,

Tu as tout à fait raison!

Message compris, testé et rectifié comme suit :
Code:
[SIZE=2][COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD[/I][/B][/COLOR]

[COLOR=NAVY]Function[/COLOR] TrackErr(R1 [COLOR=NAVY]As[/COLOR] Range, R2 [COLOR=NAVY]As[/COLOR] Range) [COLOR=NAVY]As [B]Variant[/B][/COLOR]
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] TabResult [COLOR=NAVY]As Variant
Dim[/COLOR] L [COLOR=NAVY]As Long
    If[/COLOR] R1.Count <> R2.Count [COLOR=NAVY]Then[/COLOR]
        [B]TrackErr = "Err.Plages sources!"[/B]
        [COLOR=NAVY]Exit Function
    End If
    ReDim[/COLOR] TabResult(1 [COLOR=NAVY]To[/COLOR] R1.Count - 1)
    [COLOR=NAVY]For[/COLOR] L = 2 [COLOR=NAVY]To[/COLOR] R1.Count
        TabResult(L - 1) = (R1(L).Value / R1(L - 1).Value) - (R2(L).Value / R2(L - 1).Value)
    [COLOR=NAVY]Next[/COLOR] L
    TrackErr = Application.StDev(TabResult) * Sqr(52)
[COLOR=NAVY]End Function[/COLOR][/SIZE]
Pour simplifier, je me contente de définir le retour de fonction en Variant (au lieu de Double) et je transforme la MsgBox en message d'erreur dans la cellule.

Cordialement,
 
Re : Function un peu spéciale ?

Bonjour à tous, bonjour le forum,

Très bon ce code ! ; ) merciii beaucoup

Je vais abuser mais j'essaye de faire un autre ratio et le résultat n'est pas bon alors que la formule me parait juste :
--------------------
Function BetaPerso(Fonds As Range, Indice As Range) As Variant
Dim TabResult1 As Variant
Dim TabResult2 As Variant
Dim L As Long
If Fonds.Count <> Indice.Count Then
BetaPerso = "Err.Plages sources!"
Exit Function
End If
ReDim TabResult1(1 To Fonds.Count - 1)
ReDim TabResult2(1 To Indice.Count - 1)

For L = 2 To Fonds.Count
TabResult1(L - 1) = Application.Ln(Fonds(L).Value / Fonds(L - 1).Value)
TabResult2(L - 1) = Application.Ln(Indice(L).Value / Indice(L - 1).Value)
Next L

BetaPerso = Application.Covar(TabResult1, TabResult2) * Application.Var(TabResult2)


End Function

-----------------

Comme la formule précédente il me faut calculer les rentabilités périodiques (cette fois avec Ln) des deux séries mais au lieu d'en faire la différence il faut que je fasse :
=covariance(série1 de rentabilité; série2 de rentabilité)/var(série2 de rentabilité)
et la formule ne fonctionne pas. Je transmets ci-joint un fichier excel avec la formule et le code.

Merci d'avance.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
911
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
903
Réponses
9
Affichages
884
Réponses
0
Affichages
657
Réponses
7
Affichages
829
  • Question Question
Microsoft 365 macro vba sumifs
Réponses
5
Affichages
750
B
  • Question Question
Réponses
3
Affichages
1 K
Réponses
7
Affichages
1 K
Retour