[elektro] VBA Sub Func

nemeth.tibor798 at t-online.hu nemeth.tibor798 at t-online.hu
Tue Sep 25 13:12:34 CEST 2012


Hali!

Kell még segítség.
Tehát mint írtam, a tömbképlet használatát sikerült
megfejtenem, és erre építve a függvényem által több
(meredekség, súlyponti koordináták, átlagos négyzetes
eltérés) értéket visszaadni. Ezzel is küzdök már egy ideje,
de valaki súgott, hogy a tömbképlet csak vízszintesen
működik én meg függőlegesen próbálkoztam vele. Amióta ebbe
beletörődtem, azóta ez nem gond.

A gond továbbra is: szeretném az egyedi pontok eltérését 
megjeleníteni a számoló táblában ami ez a sor lenne:
  ydiff.Item(ii)=rr 
de ez sajnos hibajelzést generál és persze nem is hajtja
végre. Itt vdiff egy paraméterként kapott "range".
ydiff.item(ii) helyett már próbáltam cells(kiszámított
index) formában is de ugyan az volt a kimenetele.

Üdv.
                     Németh Tibor






"Bánhidi István" <banhidi.istvan at gmail.com> írta:

> 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]
> >
> -----------------------------------------
>           elektro[-flame|-etc]



More information about the Elektro mailing list