[elektro] VBA Sub Func

[Bánhidi István]

Tibi,

Végül sikerült megoldanod vagy sem?
Kell még segítség?

üdv.
Steve

2012. szeptember 15. 22:12 Nemeth Tibor írta, <nemeth.tibor798 at t-online.hu>:

> Hali!
>
> 2012.09.15. 6:36 keltezéssel, Bánhidi István írta:
> > F1 nekem már sokszor segített :)
> > Kódrészlet, esetleg a munkafüzet?
>
> Nos itt van:
> ----------------------------------------------------------
> Function egyenget(xek As Range, yok As Range, ydiff As Range, resuplus
> As Range) As Double
> Dim xs As Double, ys As Double, rr As Double, qq As Double, slop As
> Double, ii As Integer, nn As Integer
> nn = xek.Count
> If (nn > 1) And (nn = yok.Count) Then
> xs = 0: ys = 0
> For ii = 1 To nn: xs = xs + xek.Item(ii): ys = ys + yok.Item(ii): Next ii
> qq = 0: slop = 0: xs = xs / nn: ys = ys / nn
> For ii = 1 To nn
> rr = xs - xek.Item(ii): slop = slop + rr * (ys - yok.Item(ii)): qq = qq
> + rr * rr
> Next ii
> slop = slop / qq
> qq = 0:
> For ii = 1 To nn
> rr = (xek.Item(ii) - xs) * slop - (yok.Item(ii) - ys): qq = qq + rr * rr
> ' ydiff.Item(ii)=rr ***No ez az ami nem megy
> Next ii
> qq = Sqr(qq / nn)
>
> 'resuplus.item(1)=slope:resuplus.item(2)=qq:resuplus.item(3)=xs:resuplus.item(4)=ys
>   ***Ez sajon nem megy
> egyenget = slop 'csak ezt tudom visszaadni
> Else
>   MsgBox ("Nem megfelelő méretű operandusok")
> End If
> End Function
> ----------------------------------------------------------
>
> Ezt szeretném de e két sor amiben van ***, ki van kommentezve mert nem
> hajtja végre. Ha megpróbálom #ÉRTÉK! jelenik meg a cellában ahol a
> függvényhívást tartalmazó  képlet van és persze a megkívánt egyéb
> helyekre sem ír.
> A gond az írással van, a ydiff.item(1)-et olvasni tudja.
> Írni nem tudok direktben sem tehát a cells(1,2)=3 is ugyanazt a hibát
> okozza.
>
> Közben valamire jutottam. Sikerült tömbértéket visszaadó formában
> megírni, a fene se gondolta volna, hogy a függvény típusát ehhez üresen
> kell hagyni.
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>
> Function egyenget_2(xek As Range, yok As Range, ydiff As Range)
> Dim xs As Double, ys As Double, rr As Double, qq As Double, slop As
> Double, ii As Integer, nn As Integer
> Dim resuplus(3) As Double
>
>      itt mint fentebb
>
> qq = Sqr(qq / nn)
> resuplus(0) = slop: resuplus(1) = qq: resuplus(2) = xs: resuplus(3) = ys
> egyenget_2 = resuplus
> Else
>   MsgBox ("Nem megfelelő méretű operandusok")
> End If
> End Function
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
>
> Eddig azt sem tudtam, hogy a tömbképlet csak vízszintesen működik, eddig
> oszlopban próbáltam sikertelenül. Ez most itt a forrásból nem látszik,
> de a munkalapon így már működik, a kijelölt négy szomszédos cellában
> megjelenik a négy kiszámított érték.
> No, ma már jó napom van de sajnos a ydiff tartomány elérése még mindig
> megoldatlan.
>
> Üdv.
>                Németh Tibor
>
> -----------------------------------------
>           elektro[-flame|-etc]
>