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

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 和 V 定义为 Range 或 Double 无济于事。我该如何解决这个问题？

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

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

这行得通吗？或者这会产生问题，因为输出将是一个字符串，而我将“MyFunction”定义为双精度？如果是这样，如何解决或者有更好的方法来强制用户做出相同大小的范围选择？

Answer 1

请试试这个功能。它已经过测试，除了我在其中添加括号的公式，但是，将加法与乘法分开，例如 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

Answer 2

已编译但未测试...

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