Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Statistical UDFs
I skimmed through your code and nothing jumped out. I would suggest calling
them with a sub and passing the same ranges in as arguments. If you do that, I suspect you will get an error message in at least one of them and this may be halting the calculation loop. sub Main Dim v as Variant Dim v1 as Variant v = AbunLog(Range("A1:B5"), Range("A6:B10")) v1 = AbunGeo(Range("A1:B5"),Range("A6:B10")) and so forth End Sub -- Regards, Tom Ogilvy "pablocampbell" wrote in message news:pablocampbell.1zyqzy_1134451802.2474@excelfor um-nospam.com... OK Fellas, I'm new to this, that is, to this forum, and to Excel UDFs in VBA. I wrote some multicell-argument UDFs (actually 5 on one module) and was able to execute the functions once on a worksheet. However, when I tried to excute a second time using a second set of arguments on the same worksheet, I got the #VALUE Error for four(4) of the five(5) cases. The excel file with the UDFs is attached. The UDF that was successfully recalculated using another multicell argument is AbunGeo(). The other four give me errors after one successful implementation on th worksheet. AbunGeo() had been the first in the code, so I flipped order to see if putting AbunLog() first would make a difference. I'm clueless, and a bit of a dummy here. dont see why flipping the order should make a difference, but I'm desperate. I have no clue what's wrong but I'm hoping this is no big deal - that I'm just clueless about the obvious. Can you help? Remember, I'm new to this. Are there some standard precationary procedures that I'm missing? Paul PS: Code of the first 3 function shown below (couldnt do all cuz of post size limit). Zip of the excel file is also attached ----------------------------------------------------------- Option Base 1 Option Explicit Function AbunLog(ByVal AllData As Range, ByVal SClass As Range) As Variant Const xtol As Double = 0.00001 Dim n As Long Dim m As Long Dim i As Long Dim x As Double Dim xnxt As Double Dim xerr As Double Dim AData As Variant Dim alpha As Double Dim NumClass As Integer Dim ObsClass() As Double Dim ExpClass() As Double Dim MinSpec As Long Dim MaxSpec As Long Dim SumSpec As Long Dim NumSpec As Long Dim EData As Double Dim ChiSqr As Double Dim iClass As Long Dim S_N As Double Dim SpClass As Variant Dim SpecClass As Double Dim NLog As Double NLog = 2 SpClass = SClass SpecClass = SClass(1, 1) AData = AllData NumSpec = UBound(AData, 1) SumSpec = WorksheetFunction.Sum(AData) MaxSpec = WorksheetFunction.Max(AData) S_N = NumSpec / SumSpec NumClass = Round(Log(MaxSpec) / Log(NLog)) ReDim ObsClass(NumClass) ReDim ExpClass(NumClass) x = 0.99 Do xnxt = -Log(1 - x) / (S_N - Log(1 - x)) xerr = Abs(xnxt - x) / x x = xnxt n = n + 1 Loop While (xerr xtol) And (n < 50) alpha = SumSpec * (1 - x) / x iClass = 1 ObsClass(1) = 0 For m = 1 To NumSpec i = NumSpec - m + 1 If AData(i, 1) < (NLog ^ iClass + 0.5) Then ObsClass(iClass) = ObsClass(iClass) + 1 Else iClass = iClass + 1 ObsClass(iClass) = 0 m = m - 1 End If Next m iClass = 1 ExpClass(1) = 0 For m = 1 To (NLog ^ NumClass) If m < (NLog ^ iClass + 0.5) Then ExpClass(iClass) = ExpClass(iClass) + (alpha * (x ^ m)) / m Else iClass = iClass + 1 ExpClass(iClass) = 0 m = m - 1 End If Next m ExpClass(NumClass) = 0 ExpClass(NumClass) = NumSpec - WorksheetFunction.Sum(ExpClass) ChiSqr = 0 If (SpecClass < 1) Or (SpecClass NumClass) Then For m = 1 To NumClass ChiSqr = ChiSqr + (ExpClass(m) - ObsClass(m)) ^ 2 / ExpClass(m) AbunLog = ChiSqr Next m Else AbunLog = ExpClass(SpecClass) End If If n = 50 Then AbunLog = "Error" End If End Function Function AbunGeo(ByVal AllData As Range, ByVal SpecData As Range) As Variant Const ktol As Double = 0.00001 Dim n As Long Dim m As Long Dim i As Long Dim k As Double Dim knxt As Double Dim kerr As Double Dim ChiSqr As Double Dim AData As Variant Dim SData As Variant Dim SDAdd As String Dim Nratio As Double Dim MinSpec As Long Dim MaxSpec As Long Dim NumSpec As Long Dim SumSpec As Long Dim Ck As Double Dim iSpec As Long Dim EData As Double Dim NiSpec As Double AData = AllData NumSpec = UBound(AData, 1) MinSpec = WorksheetFunction.Min(AData) MaxSpec = WorksheetFunction.Max(AData) SumSpec = WorksheetFunction.Sum(AData) Nratio = MinSpec / SumSpec k = 1 Do knxt = 1 - ((1 - (1 - k) ^ NumSpec) * Nratio / k) ^ (1 / (NumSpec - 1)) kerr = Abs(knxt - k) / k k = knxt n = n + 1 Loop While (kerr ktol) And (n < 50) Ck = 1 / (1 - (1 - k) ^ NumSpec) iSpec = SpecData.Row - AllData.Row + 1 ChiSqr = 0 If (iSpec NumSpec) Or (iSpec < 1) Then For m = 1 To NumSpec EData = SumSpec * Ck * k * (1 - k) ^ (m - 1) ChiSqr = ChiSqr + (EData - AData(m, 1)) ^ 2 / EData AbunGeo = ChiSqr Next m Else NiSpec = SumSpec * Ck * k * (1 - k) ^ (iSpec - 1) AbunGeo = NiSpec End If If n = 50 Then AbunGeo = "Error" End If End Function Function AbunTln(ByVal AllData As Range, ByVal SClass As Range) As Variant Dim m As Long Dim i As Long Dim AData As Variant Dim ChiSqr As Double Dim gamma As Double Dim theta As Double Dim NumClass As Integer Dim ObsClass() As Double Dim ExpClass() As Double Dim MinSpec As Long Dim MaxSpec As Long Dim SumSpec As Long Dim NumSpec As Long Dim EData As Double Dim iClass As Long Dim MeanLog As Double Dim MLog As Double Dim VarLog As Double Dim VLog As Double Dim z0 As Double Dim p0 As Double Dim NSpec As Double Dim TotSpec As Double Dim SpClass As Variant Dim SpecClass As Double Dim NLog As Double NLog = 2 SpClass = SClass SpecClass = SClass(1, 1) AData = AllData NumSpec = UBound(AData, 1) SumSpec = WorksheetFunction.Sum(AData) MaxSpec = WorksheetFunction.Max(AData) NumClass = Round(Log(MaxSpec) / Log(NLog)) ReDim ObsClass(NumClass) ReDim ExpClass(NumClass) iClass = 1 ObsClass(1) = 0 For m = 1 To NumSpec i = NumSpec - m + 1 If AData(i, 1) < (NLog ^ iClass + 0.5) Then ObsClass(iClass) = ObsClass(iClass) + 1 Else iClass = iClass + 1 ObsClass(iClass) = 0 m = m - 1 End If Next m MLog = 0 For m = 1 To NumSpec MLog = MLog + (Log(AData(m, 1)) / Log(10#)) Next m MLog = MLog / NumSpec MeanLog = MLog VLog = 0 For m = 1 To NumSpec VLog = VLog + ((Log(AData(m, 1)) / Log(10#)) - MeanLog) ^ 2 Next m VLog = VLog / NumSpec gamma = (VLog ^ 2) / ((MLog + 0.301029996) ^ 2) If gamma < 0.23 Then theta = Exp(1.46451 * (Log(gamma)) ^ 5 + 14.76956 * (Log(gamma)) ^ 4 + 59.76631 * (Log(gamma)) ^ 3 + 119.79856 * (Log(gamma)) ^ 2 + 122.17853 * (Log(gamma)) ^ 1 + 48.39711) Else theta = Exp(1.77458 * (Log(gamma)) ^ 5 + 8.64157 * (Log(gamma)) ^ 4 + 16.8518 * (Log(gamma)) ^ 3 + 16.66023 * (Log(gamma)) ^ 2 + 11.98243 * (Log(gamma)) ^ 1 + 3.6939) End If MeanLog = MLog - theta * (MLog + 0.301029996) VarLog = VLog ^ 2 + theta * (MLog + 0.301029996) ^ 2 z0 = (-0.301029996 - MeanLog) / (VarLog ^ 0.5) p0 = WorksheetFunction.NormSDist(z0) NSpec = NumSpec / (1 - p0) TotSpec = NSpec - NumSpec For m = 1 To (NumClass - 1) ExpClass(m) = NSpec * WorksheetFunction.NormSDist((Log(NLog ^ m + 0.5) / Log(10#) - MeanLog) / (VarLog ^ 0.5)) - TotSpec TotSpec = TotSpec + ExpClass(m) Next m ExpClass(NumClass) = NSpec - TotSpec ChiSqr = 0 If (SpecClass < 0) Or (SpecClass NumClass) Then For m = 1 To NumClass ChiSqr = ChiSqr + (ExpClass(m) - ObsClass(m)) ^ 2 / ExpClass(m) AbunTln = ChiSqr Next m Else If SpecClass = 0 Then AbunTln = NSpec - NumSpec Else AbunTln = ExpClass(SpecClass) End If End If End Function +-------------------------------------------------------------------+ |Filename: StatsPAC.zip | |Download: http://www.excelforum.com/attachment.php?postid=4116 | +-------------------------------------------------------------------+ -- pablocampbell ------------------------------------------------------------------------ pablocampbell's Profile: http://www.excelforum.com/member.php...o&userid=29592 View this thread: http://www.excelforum.com/showthread...hreadid=492958 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help and description for UDFs | Excel Worksheet Functions | |||
UDFs | Excel Programming | |||
VBA, UDFs and VSTO | Excel Programming | |||
'portable' UDFs??? | Excel Programming | |||
Acrobat 6.0 and UDFs | Excel Programming |