繁体   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