Définir fonction VBA vectorielle utilisable dans formules

Question

Je cherche à définir une fonction VBA de nature vectorielle, que je puisse ensuite utiliser normalement dans des formules excel vectorielles. Un peu à la manière de fonction excel DROITEREG qui à partir des données nécessaires à la régression, donne tout un ensemble de résultat sous la forme d'une matrice. On note de plus que la matrice résultats n'est pas complète ou rectangulaire selon le point de vue. C'est idéalement le même type de fonction que j'aimerais créer. Ci-joint ma tentative qui ne fonctionne pas. J'ai donné à la fonction le type Range. Mais l'affectation des résultats de sortie ne fonctionne pas. Merci de votre airde JPC...

EngueEngue · Answer

Donne lui le type variant et dans ton variant tu fous un tableau qui lui contiendra un range .....

EngueEngue · Answer

Tu fais n'importe quoi oui. Function bruit_bilin(Temp As Range) As Variant ' ' ' Dim Res(0 To 6) Dim T(25), Ti, dx As Double Dim dTA, VarA, dTB, VarB, Var As Double Dim STAr, dTAr, VarAr, STBr, dTBr, VarBr As Double Dim ST2, ST2A, ST2B, SiTA, SiTB, STA, STB As Double Dim Mm, Smm, mMp, Spp As Double Dim i, im, m, n, p, mr As Integer dx = Range("pas").Value / 60 ' pas de temps des donnés en minutes n = Temp.Count m = 3 Mm = (m + 1) / 2 Smm = (m - 1) * m * Mm / 6 p = n - 3 mMp = m + (p + 1) / 2 Spp = (p - 1) * p * (p + 1) / 12 STA = 0 SiTA = 0 ST2A = 0 For i = 1 To m Ti = Temp.Cells(i, 1).Value T(i) = Ti STA = STA + Ti SiTA = SiTA + i * Ti ST2A = ST2A + Ti * Ti Next i STB = 0 SiTB = 0 ST2B = 0 For i = m + 1 To n Ti = Temp.Cells(i, 1).Value T(i) = Ti STB = STB + Ti SiTB = SiTB + i * Ti ST2B = ST2B + Ti * Ti Next i mr = m STAr = STA ' somme des Ti sur 1..m dTAr = SiTA - Mm * STA VarAr = ST2A - STA * STA / m - dTAr * dTAr / Smm STBr = STB ' somme des Ti sur m+1..n dTBr = SiTB - mMp * STB VarBr = ST2B - STB * STB / p - dTBr * dTBr / Spp Var = VarAr + VarBr For m = 4 To n - 3 Ti = T(m) STA = STA + Ti SiTA = SiTA + m * Ti ST2A = ST2A + Ti * Ti Mm = Mm + 0.5 Smm = Smm + (m - 1) * m / 4 dTA = SiTA - Mm * STA VarA = ST2A - STA * STA / m - dTA * dTA / Smm STB = STB - Ti SiTB = SiTB - m * Ti ST2B = ST2B - Ti * Ti mMp = mMp + 0.5 Spp = Spp - (p - 1) * p / 4 p = p - 1 dTB = SiTB - mMp * STB VarB = ST2B - STB * STB / p - dTB * dTB / Spp If VarA + VarB &lt; Var Then mr = m Var = VarA + VarB STAr = STA dTAr = dTA VarAr = VarA STBr = STB dTBr = dTB VarBr = VarB End If Next m m = mr Smm = (m - 1) * m * (m + 1) / 12 Res(0) = m Res(1) = dTAr / Smm / dx Res(2) = Sqr(VarAr / (m - 2)) p = n - m Spp = (p - 1) * p * (p + 1) / 12 Res(3) = dTBr / Spp / dx Res(4) = Sqr(VarBr / (p - 2)) Res(5) = 10 * Sqr(Var / (n - 2)) bruit_bilin = Res End Function...

EngueEngue · Answer

Et que fais tu avec tes deux pentes ?

Tu projettes et donnes un intervalle ?

Généralement tes droites de régression formeront un angle, si cet angle est aigu il aurait mieux valu faire une droite régressive, si il est obtus ton intervalle sera de plus en plus grand.

J'ai un grand intérêt pour la question, dis m'en plus.

Je ne comprends pas comment fais tu une erreur type globale.

Pour répondre à ta question il suffit de mettre T as range

X as variant

x prend T

puis calculer ubound(x)

EngueEngue · Answer

2 minutes = 12 observations ... Ton estimateur sera très mauvais.

4 minutes = 24 observations ... Presque aussi mauvais.

Je ne me suis pas trop plongé sur la question... Mais tes calculs de variances avec des sommes m'interpellent. La variance a des propriétés qu'il ne faut pas simplifier. Il se peut que tes variables temps et température ne soient pas corrélées mais ceci m'interpellerait puisque sinon aucun intérêt de faire l'analyse.

Je n'arrive toujours pas à saisir l'intérêt... Puisque intuitivement...

"Chercher deux droites qui minimisent la somme des écarts au carré."

Reviendrait à en trouver deux superposées dans le cas où l'on trouve en relation entre notre X et notre Y et deux droites séparées dans le cas où il y ait deux distributions. Il faudrait donc diviser notre échantillon en deux et faire passer un MCO sur chacun d'entre eux.

Je ne dévalorise en rien ta modélisation qui sort des chantiers battus mais ne comprenant pas je creuse.

EngueEngue · Answer

Je reste sceptique.

Mon ordinateur a mis 1m21sec pour lancer 600 000 fois ta fonction.

Si tu évites les 600 000 updates du screen tu devrais mieux t'en sortir..

Option Explicit
Function bruit_bilin(Temp As Range) As Variant
'
'
'
   Dim Res(0 To 6)
    Dim T(25), Ti, dx As Double
    Dim dTA, VarA, dTB, VarB, Var As Double
    Dim STAr, dTAr, VarAr, STBr, dTBr, VarBr As Double
    Dim ST2, ST2A, ST2B, SiTA, SiTB, STA, STB As Double
    Dim Mm, Smm, mMp, Spp As Double
    Dim i, im, m, n, p, mr As Integer

    dx = Range("pas").Value / 60    ' pas de temps des donnés en minutes
   n = Temp.Count
    m = 3
    Mm = (m + 1) / 2
    Smm = (m - 1) * m * Mm / 6
    p = n - 3
    mMp = m + (p + 1) / 2
    Spp = (p - 1) * p * (p + 1) / 12

    STA = 0
    SiTA = 0
    ST2A = 0
    For i = 1 To m
        Ti = Temp.Cells(i, 1).Value
        T(i) = Ti
        STA = STA + Ti
        SiTA = SiTA + i * Ti
        ST2A = ST2A + Ti * Ti
    Next i
    STB = 0
    SiTB = 0
    ST2B = 0
    For i = m + 1 To n
        Ti = Temp.Cells(i, 1).Value
        T(i) = Ti
        STB = STB + Ti
        SiTB = SiTB + i * Ti
        ST2B = ST2B + Ti * Ti
    Next i

    mr = m
    STAr = STA                                          ' somme des Ti sur 1..m
   dTAr = SiTA - Mm * STA
    VarAr = ST2A - STA * STA / m - dTAr * dTAr / Smm
    STBr = STB                                          ' somme des Ti sur m+1..n
   dTBr = SiTB - mMp * STB
    VarBr = ST2B - STB * STB / p - dTBr * dTBr / Spp
    Var = VarAr + VarBr

    For m = 4 To n - 3
        Ti = T(m)
        STA = STA + Ti
        SiTA = SiTA + m * Ti
        ST2A = ST2A + Ti * Ti
        Mm = Mm + 0.5
        Smm = Smm + (m - 1) * m / 4
        dTA = SiTA - Mm * STA
        VarA = ST2A - STA * STA / m - dTA * dTA / Smm
        STB = STB - Ti
        SiTB = SiTB - m * Ti
        ST2B = ST2B - Ti * Ti
        mMp = mMp + 0.5
        Spp = Spp - (p - 1) * p / 4
        p = p - 1
        dTB = SiTB - mMp * STB
        VarB = ST2B - STB * STB / p - dTB * dTB / Spp
        If VarA + VarB < Var Then
            mr = m
            Var = VarA + VarB
            STAr = STA
            dTAr = dTA
            VarAr = VarA
            STBr = STB
            dTBr = dTB
            VarBr = VarB
        End If
    Next m

    m = mr
    Smm = (m - 1) * m * (m + 1) / 12
    Res(0) = m
    Res(1) = dTAr / Smm / dx
    Res(2) = Sqr(VarAr / (m - 2))
    p = n - m
    Spp = (p - 1) * p * (p + 1) / 12
    Res(3) = dTBr / Spp / dx
    Res(4) = Sqr(VarBr / (p - 2))

    Res(5) = 10 * Sqr(Var / (n - 2))

    bruit_bilin = Res

End Function

Sub toto()
    Dim debut As Date, temps As Date, fin As Date, i As Double
    debut = Time
    For i = 1 To 600000
        Call bruit_bilin(Range("B2:B20"))
    Next i
    fin = Time
    temps = fin - debut
    MsgBox ("C'est fini !" & Chr(10) & "temps de traitement " & temps)
End Sub

EngueEngue · Answer

Appelle des milliers de fois ta fonction depuis un sub... avec un application.screenupdating=false et il ne devrait pas y avoir de problemes... en effet l'appel de 600000 fois ta fonction ne dure qu'une minute et demie.. sachant que chaque fonction va écrire 6 cases. L'écriture de 3 millions 600000 données devrait prendre peut être 1 minute et moins si tu passes un tableau à un range. C'est sur que le recalcul de tes milliers de fonctions prendra un temps fou puisqu'il réactualisera les 600000 formules une par une..

Si tu me donnes un exemple réduit de ton utilisation je peux t'aider.