VBA-创建用户自定义函数

Question

我想创建一个函数，该函数将返回给定持续时间的分布的期望值。 输入将仅为以下格式 ExpValue（Jan-01/June30; EXPO（2000），July - 01/Dec-31; NORM（1000,2000）） 其中Jan-01/6月30日和7月 - 01/12月 - 31日是持续时间。 而且，EXPO（2000）和NORM（1000,2000）是该特定季节数据的分布类型（平均值，标准偏差等在括号中提供）。用户只需输入分配类型的起始4个字母，如： 正常分布的NORM EXPOENTIALAL分配的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 

Answer 1

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（，）函数中不能使用“，”。 所以“ - ”分割日期，“;”拆分函数，并且“|”拆分了两个方程。

这里是我的尝试，代码应procude：，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