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

问题描述：

我想创建一个用户定义的函数，以便在Excel工作表中使用。我的函数使用三个单元格范围作为输入，并应返回一个单一的值作为结果。如此，它在结构上与例如SUMPRODUCT函数，只有执行的数学是不同的。如何在工作表中使用单元格范围的UDF？

这是我使用的代码：

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作为范围或双无济于事。我怎么解决这个问题？

除了这个问题，我也想知道如何确保选定的单元格区域具有相同的大小。我正在想办法：

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”定义为double？如果是这样，那么如何解决或有更好的方法来强制用户做出相同大小的范围选择？

答

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

感谢您的帮助。我现在得到了一个实际的结果（虽然不是正确的;我需要重新检查我的公式）。 – Enantiomeer

我还在想，是否可以强制该函数只接受一维水平单元格范围（行）。 – Enantiomeer

我修改了代码以包含多行选择的拒绝。实际上这并不是必需的，但是，因为代码只处理第一行。如果您的工作表的结构允许，让用户选择第一个范围并让代码找到其他范围会更好。如果其他两个连续行，这将是可能的。 – Variatus

答

编译，未经测试...

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

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

相关推荐