[elektro] VBA Sub Func

[Nemeth Tibor]

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