简体   繁体   中英

VBA- creating a user defined function

I want to create a function, which would return the expected value of a distribution for the given duration. The input will be in the following format only ExpValue(Jan--01/June30;EXPO(2000),July--01/Dec--31;NORM(1000,2000)) where the Jan--01/June30 and July--01/Dec--31 are the duration. And, EXPO(2000) and NORM(1000,2000) are the type of distribution (with mean, std deviation, etc provided in the parenthesis) of the data for that particular season. The user has to input only starting 4 letter for the type of distribution, like: NORM for NORMAL distribution EXPO for EXPONENTIAL distribution, etc. There can be as many seasons as possible, separated by"," and the type of duration for each season is mentioned respectively separated from the duration by ";".

I have written the code for the function, but it is not working. Please suggest me the required changes.

Public Function ExpValue(str As String) As String

Dim Mylen As Integer
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Double
Dim N As Integer
Dim ExpectValue As Double
Dim Arr1() As String
Dim Arr2() As String
Dim Arr3() As String
Dim Arr4() As String
Dim Arr5() As String
Dim Arr6() As String
Dim Arr7() As Double
Dim txt1 As String
Dim txt2 As String
Dim txt3 As String
Dim txt4 As String
Dim txt5 As String
Dim txt6 As String

Arr1() = Split(str, ",")
C = UBound(Arr1())
ReDim Arr1(C) As String

    For i = 0 To C

            Arr2() = Split(Arr1(i), ";")
            ReDim Arr2(1) As String
            Arr3(i) = Arr2(0)
            Arr4(i) = Arr2(1)

    Next i

    ReDim Arr3(C) As String
    ReDim Arr4(C) As String

    For i = 0 To C
        txt1 = Arr4(i)
        Mylen = Len(txt1)
        txt2 = Left(txt1, 4)        ' type of distribution
        A = Mylen - 5
        B = Mylen - 6
        txt3 = Right(txt1, A)       ' 1,2.3,4,... )
        txt4 = Left(txt3, B)        ' 1,2.3,4.,..
        Arr5 = Split(txt4, ",")
        D = UBound(Arr5())

        ReDim Arr7(D) As Double
            For j = 0 To D
                Arr7(i) = CDbl(Arr5(i))
            Next j

        Select Case txt2

            Case "EXPO", "POIS"             ' just one number EXPO(2.34)
            l = CDbl(txt4)                  ' txt4=2.34
            Arr6(i) = l

            Case "NORM"
            ExpectValue = Arr7(1)
            Arr6(i) = ExpectValue

            Case "BETA"
            ExpectValue = (Arr7(1) / (Arr7(0) + Arr7(1)))
            Arr6(i) = ExpectValue

            Case "GAMM"
            ExpectValue = Arr7(0) * Arr7(1)
            Arr6(i) = ExpectValue

            Case "TRIA"
            ExpectValue = ((Arr7(0) + Arr7(1) + Arr7(2)) / 3)
            Arr6(i) = ExpectValue

            Case "UNIF"
            ExpectValue = ((Arr7(0) + Arr7(1)) / 2)
            Arr6(i) = ExpectValue

            Case "LOGN"
            ExpectValue = Exp((Arr7(0) + ((Arr7(1)) ^ 2)) / 2)
            Arr6(i) = ExpectValue

            Case "ERLA"
            ExpectValue = Arr7(0) * Arr7(1)
            Arr6(i) = ExpectValue

        End Select

    'Next j
    Next i
    'i = i + 1

    If C = 0 Then
        txt6 = Arr3(0) & ";" & Arr6(0)
    Else
        txt6 = ""

        For i = 0 To C
            txt6 = txt6 & "," & Arr3(i) & "," & Arr6(i)
        Next i

    End If

    ExpValue = txt5

End Function
DateDiff("d",FirstDate,SecondDate) '+ 1

Will give the difference in days between the two dates, "m" for months etc. This will give you from first date, so will exclude it, so if you want total days just +1.

As for your code above, I got it working, but hard to understand what you are trying to achieve. There's probably better ways than passing the whole equation as a string.

=ExpValue("1/1/2001-30/6/2001;EXPO(2000)|1/7/2001-31/12/2001;NORM(1000,2000)")

I changed a few things in the equation to better identify the split parts in the string. Can't use "," as it is conained in the NORM(,) function. So "-" splits the dates, ";" splits the function, and "|" splits the two equations.

Here is my attemp, the code should procude: ,181,2000,184,1000 Where 181 and 184 is the number of days between the two dates enetered. I believe the select case methods aren't working correctly either, but with a working function you can improve it.

Public Function ExpValue(str As String) As String

Dim Mylen As Integer, A As Integer, B As Integer, C As Integer, D As Integer, i As Integer
Dim j As Integer, k As Integer, l As Double, N As Integer, ExpectValue As Double
Dim Arr1() As String, Arr2() As String, Arr3() As String, Arr4() As String, Arr5() As String
Dim Arr6() As String, Arr7() As Double, txt1 As String, txt2 As String, txt3 As String
Dim txt4 As String, txt5 As String, txt6 As String

Dim d1 As Date, d2 As Date, ArrDate() As String
Dim dPart() As Integer

Arr1() = Split(str, "|")
C = UBound(Arr1())

ReDim Arr3(C)
ReDim Arr4(C)
ReDim dPart(C)


For i = 0 To C
    Arr2() = Split(Arr1(i), ";")
    Arr3(i) = Arr2(0)
    Arr4(i) = Arr2(1)

    ArrDate() = Split(Arr2(0), "-")
    d1 = ArrDate(0)
    d2 = ArrDate(1)
    dPart(i) = DateDiff("d", d1, d2) + 1
Next i

ReDim Preserve Arr3(C) As String
ReDim Preserve Arr4(C) As String
ReDim Arr6(C)

For i = 0 To C
    If Arr4(i) <> "" Then
    txt1 = Arr4(i)
    Mylen = Len(txt1)
    txt2 = Left(txt1, 4)    ' type of distribution
    A = Mylen - 5
    B = Mylen - 6
    txt3 = Right(txt1, A)    ' 1,2.3,4,... )
    txt4 = Left(txt3, B)        ' 1,2.3,4.,..
    Arr5 = Split(txt4, ",")
    D = UBound(Arr5())

    ReDim Preserve Arr7(D) As Double

        For j = 0 To D
                Arr7(j) = CDbl(Arr5(0))
        Next j

        Select Case txt2

        Case "EXPO", "POIS"        ' just one number EXPO(2.34)
        l = CDbl(txt4)        ' txt4=2.34
        Arr6(i) = l

        Case "NORM"
        ExpectValue = Arr7(0)
        Arr6(i) = ExpectValue

        Case "BETA"
        ExpectValue = (Arr7(1) / (Arr7(0) + Arr7(1)))
        Arr6(i) = ExpectValue

        Case "GAMM"
        ExpectValue = Arr7(0) * Arr7(1)
        Arr6(i) = ExpectValue

        Case "TRIA"
        ExpectValue = ((Arr7(0) + Arr7(1) + Arr7(2)) / 3)
        Arr6(i) = ExpectValue

        Case "UNIF"
        ExpectValue = ((Arr7(0) + Arr7(1)) / 2)
        Arr6(i) = ExpectValue

        Case "LOGN"
        ExpectValue = Exp((Arr7(0) + ((Arr7(1)) ^ 2)) / 2)
             Arr6(i) = ExpectValue

        Case "ERLA"
        ExpectValue = Arr7(0) * Arr7(1)
        Arr6(i) = ExpectValue

        End Select
    End If
    Next i

    If C = 0 Then
        txt6 = dPart(0) & ";" & Arr3(0) & ";" & Arr6(0)
    Else
        txt6 = ""

        For i = 0 To C
            txt6 = txt6 & "," & dPart(i) & "," & Arr6(i)
        Next i
    End If

    ExpValue = txt6

End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM