ワークシート内のセル範囲でUDFを使用する方法は？

Question

Excelワークシートで使用するためのユーザー定義関数を作成しようとしています。私の関数は、入力として3つのセル範囲を使用し、結果として1つの単一の値を返す必要があります。そのようなものとして、それは、例えば、 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使用の配列を定義しようとしています。どうすればこの問題を解決できますか？

この問題の他に、選択されているセル範囲が同じサイズであることをどのように確認できるかも疑問です。

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として定義していたのに対し、出力は文字列になるので、これは問題を引き起こすでしょうか？もしそうなら、それをどのように解決することができますか、ユーザーに同じサイズの範囲選択をさせるより良い方法がありますか？

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