VBA-创建用户定义的函数

时间:2012-07-05 03:48:22

标签: excel-vba vba excel

我想创建一个函数,该函数将返回给定持续时间的分布的预期值。 输入将仅采用以下格式 ExpValue(月 - 01 / June30;世博会(2000年),月 - 01 /日 - 31日; NORM(1000,2000)) 其中Jan - 01 / June30和July - 01 / Dec - 31是持续时间。 并且,EXPO(2000)和NORM(1000,2000)是该特定季节的数据的分布类型(括号中提供的均值,标准偏差等)。用户必须仅为分发类型输入4个字母,例如: 正态分布的NORM EXPONENTIAL分销等的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

1 个答案:

答案 0 :(得分:0)

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是两个日期之间的天数。我相信选择案例方法也不能正常工作,但是使用工作函数可以改进它。

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