簡體   English   中英

VBA-創建用戶定義的功能

[英]VBA- creating a user defined function

我想創建一個函數,該函數將在給定的持續時間內返回分布的期望值。 輸入將僅采用以下格式ExpValue(Jan--01 / June30; EXPO(2000),July--01 / Dec--31; NORM(1000,2000)),其中Jan--01 / June30和July持續時間--01 / Dec--31 並且,EXPO(2000)和NORM(1000,2000)是該特定季節數據的分布類型(括號中提供了均值,std偏差等)。 用戶只需輸入4個開頭的字母即可表示發行類型,例如:NORM表示正常發行,EXPO表示指數發行等。可以有盡可能多的季節,用“,”分隔,每個季節的持續時間類型分別用“;”與持續時間分開。

我已經為該函數編寫了代碼,但是無法正常工作。 請建議我所需的更改。

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

將給出兩個日期之間的天數差異,“ m”表示月份等。這將使您從第一個日期開始,因此將其排除在外,因此,如果您希望總天數僅為+1。

至於上面的代碼,我可以正常運行,但是很難理解您要實現的目標。 可能有比將整個方程式作為字符串傳遞更好的方法。

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

我更改了等式中的一些內容,以更好地識別字符串中的拆分部分。 在NORM(,)函數中不能使用“,”。 因此,“-”分割日期“;” 拆分函數,然后使用“ |” 拆分兩個方程。

這是我的嘗試,代碼應進行以下處理:,181,2000,184,1000其中181和184是設定的兩個日期之間的天數。 我相信select case方法也無法正常工作,但是通過工作功能,您可以對其進行改進。

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM