Question

我正在尝试创建用户定义的函数以在excel工作表中使用。我的函数使用三个单元格范围作为输入，并应返回一个单独的值作为结果。因此，它在结构上类似于例如SUMPRODUCT函数，只有执行的数学运算是不同的。

这是我使用的代码：

Function MyFunction(C(), V(), M()) As Double
    Application.Volatile (True)

    Dim i As Long, j As Long, x As Long
    Dim Sum_Phi_i As Double

    x = UBound(C, 0)

    MyFunction = 0
    For i = 0 To x
        Sum_Phi_i = 0
        For j = 0 To x
        Sum_Phi_i = Sum_Phi_i + C(j) * Sqr(2) / (4 * Sqr(1 + M(i) / M(j))) * (1 + Sqr(V(i) / V(j)) * (M(j) / M(i)) ^ 0.25) ^ 2
            Next j
        MyFunction = MyFunction + C(i) * V(i) / Sum_Phi_i
        Next i

End Function

我遇到的问题是它返回#VALUE！错误。显然我错误地定义了数据类型，因为当我在工作表中使用此函数时，我得到： A value used in the formula is of the wrong data type

我尝试过定义使用过的数组C，M＆amp; V作为范围或双重无效。我该如何解决这个问题？

除了这个问题，我还想知道如何确保所选的单元格范围具有相同的大小。我在考虑一些事情：

x = UBound(C, 0)
y = UBound(M, 0)
z = UBound(M, 0)

If x <> y Or x <> z Or y <> z Then MyFunction = "Arrays are not of same size"
If x <> y Or x <> z Or y <> z Then Exit Function

这会有用吗？或者这会产生问题，因为输出将是一个字符串，而我定义了我的＆＃34; MyFunction＆＃34;加倍？如果是这样，如何解决这个问题还是有更好的方法来强制用户进行相同大小的范围选择？

Answer 1

已编译但未经过测试......

Function MyFunction(C As Range, V As Range, M As Range) As Double

    Application.Volatile True
    Dim i As Long, j As Long, x As Long
    Dim Sum_Phi_i As Double
    Dim vC, vV, vM
    vC = C.Value
    vV = V.Value
    vM = M.Value

    x = UBound(vC, 1) 'dimensions are 1 and 2 and lower bound of each=1

    MyFunction = 0
    For i = 1 To x
        Sum_Phi_i = 0
        For j = 1 To x
            Sum_Phi_i = Sum_Phi_i + vC(j) * Sqr(2) / (4 * Sqr(1 + vM(i) / vM(j))) * _
                        (1 + Sqr(vV(i) / vV(j)) * (vM(j) / vM(i)) ^ 0.25) ^ 2
        Next j
        MyFunction = MyFunction + (vC(i) * vV(i) / Sum_Phi_i)
    Next i

End Function

Answer 2

请尝试此功能。它已经过测试，但我添加括号的公式除了将加法与乘法分开，例如Fun = Fun + (3 * 4)而不是Fun = Fun + 3 * 4。

Function MyFunction(C As Range, _
                    V As Range, _
                    M As Range) As Double
    ' 21 Oct 2017

    Application.Volatile (True)

    Dim Fun As Double                       ' function return value
    Dim ArrC, ArrV, ArrM
    Dim i As Long, j As Long, x As Long
    Dim PhiSum As Double

    ArrC = C.Value
    ArrV = V.Value
    ArrM = M.Value
    x = UBound(ArrC, 2)

    If (UBound(ArrC) > 1) Or (UBound(ArrV) > 1) Or (UBound(ArrM) > 1) Then
        MsgBox "Please specify horizontal ranges each" & vbCr & _
               "comprising a single row only.", vbExclamation, "Invalid parameter"
        Exit Function
    End If

    If (UBound(ArrV, 2) <> x) Or (UBound(ArrM, 2) <> x) Then
        MsgBox "Specified ranges must be of equal size.", _
               vbCritical, "Invalid parameter"
        Exit Function
    End If    

    For i = 1 To x
        PhiSum = 0
        For j = 1 To x
            PhiSum = PhiSum + (ArrC(1, j) * Sqr(2) _
                            / (4 * Sqr(1 + ArrM(1, i)) _
                            / ArrM(1, j)) * (1 + Sqr(ArrV(1, i) _
                            / ArrV(1, j)) * (ArrM(1, j) _
                            / ArrM(1, i)) ^ 0.25) ^ 2)
        Next j
        Fun = Fun + (ArrC(1, i) * ArrV(1, i) / PhiSum)
    Next i
    MyFunction = Fun
End Function

如何在工作表中使用带有单元格范围的UDF？

2 个答案: