用户在VBA中定义的函数不工作并返回零，没有数据types不匹配
我正在定义一个用户定义的函数，如下所示，当我试图在子程序中调用它时，它返回一个“零”值，这肯定是错误的。
Function Getpartialderiv_K_x(x As Variant, y As Variant, P As Variant, T As Variant, hx As Variant, dx As Variant) As Variant Dim i As Integer ReDim dx(1 To UBound(x, 1)) As Variant 'record the original value for x Dim original_x As Variant original_x = x 'calc f(x+1) For i = 1 To UBound(x, 1) x(i) = original_x(i) + dx(i) Next i Dim f1 As Variant f1 = ThermoRel(x, y, P, T) 'calc f(x-1) For i = 1 To UBound(x, 1) x(i) = original_x(i) - dx(i) Next i Dim f2 As Variant f2 = ThermoRel(x, y, P, T) 'calc partial deriv ReDim pderiv(1 To UBound(x, 1)) 'get the results of partial derivatives For i = 1 To UBound(x, 1) pderiv(i) = (f1(i) - f2(i)) / (2 * hx) Next i Getpartialderiv_K_x = pderiv End Function Sub click2() ReDim x(1 To 3) As Variant ReDim y(1 To 3) As Variant x = Array(0.4, 0.3, 0.3) y = Array(0.3, 0.2, 0.5) Dim P As Variant P = 1171.904923 'pressure in the unit of psia Dim T As Variant T = 527.67 'fix temperature in the unit of oR Dim hx As Variant hx = 0.001 ReDim dx(1 To 3) As Variant dx = Array(hx, 0, 0) Dim result As Variant result = Getpartialderiv_K_x(x, y, P, T, hx, dx) MsgBox (result(1)) End Sub 然而，当我试图复制定义上述函数使用子例程相同的代码，并提供相同的input值，结果是完全正确的，如下所示：
Sub click() Dim i As Integer ReDim x(1 To 3) As Variant ReDim y(1 To 3) As Variant x = Array(0.4, 0.3, 0.3) y = Array(0.3, 0.2, 0.5) Dim P As Variant P = 1171.904923 'pressure in the unit of psia Dim T As Variant T = 527.67 'fix temperature in the unit of oR Dim hx As Variant hx = 0.001 ReDim dx(1 To 3) As Variant dx = Array(hx, 0, 0) Dim original_x As Variant original_x = x 'calc f(x + 1) For i = 1 To 3 x(i) = original_x(i) + dx(i) Next i Dim f1 As Variant f1 = ThermoRel(x, y, P, T) 'calc f(x - 1) For i = 1 To 3 x(i) = original_x(i) - dx(i) Next i Dim f2 As Variant f2 = ThermoRel(x, y, P, T) ReDim pderiv(1 To 3) As Variant For i = 1 To 3 pderiv(i) = (f1(i) - f2(i)) / (2 * hx) Next i Msgbox(pderiv(3)) End Sub
我检查了数据types，似乎没有不匹配。 另外，ThermoRel（x，y，P，T）函数可以正常工作，并且具有不同的数据types。 我花了很多时间，想尽一切办法，但仍然不知道，你的投入将是高度赞赏！
为了让您轻松地进行debugging，我做了一个虚拟示例，其错误（输出为零）如下所示：
Option Explicit Option Base 1 Function ThermoRel2(x As Variant, y As Variant, P As Variant, T As Variant) As Variant Dim i As Integer 'component index Dim Ke As Variant 'equilibrium constant for each component Ke = Array(0.8789, 1.0389, 0.7903) ReDim outvec(LBound(x, 1) To UBound(x, 1)) As Variant For i = LBound(x, 1) To UBound(x, 1) outvec(i) = y(i) - x(i) * Ke(i) Next i ThermoRel2 = outvec End Function Function Getpartialderiv_K_x_2(x As Variant, y As Variant, P As Variant, T As Variant, hx As Variant, dx As Variant) As Variant Dim i As Integer ReDim dx(LBound(x, 1) To UBound(x, 1)) As Variant 'record the original value for x Dim original_x As Variant original_x = x 'calc f(x+1) For i = LBound(x, 1) To UBound(x, 1) x(i) = original_x(i) + dx(i) Next i Dim f1 As Variant f1 = ThermoRel2(x, y, P, T) 'calc f(x-1) For i = LBound(x, 1) To UBound(x, 1) x(i) = original_x(i) - dx(i) Next i Dim f2 As Variant f2 = ThermoRel2(x, y, P, T) 'calc partial deriv ReDim pderiv(LBound(x, 1) To UBound(x, 1)) 'get the results of partial derivatives For i = LBound(x, 1) To UBound(x, 1) pderiv(i) = (f1(i) - f2(i)) / (2 * hx) Next i Getpartialderiv_K_x_2 = pderiv End Function Sub dbg() Dim x As Variant Dim y As Variant ReDim x(1 To 3) As Variant ReDim y(1 To 3) As Variant x = Array(0.4, 0.3, 0.3) y = Array(0.3, 0.2, 0.5) Dim P As Variant P = 1171.904923 'pressure in the unit of psia Dim T As Variant T = 527.67 'fix temperature in the unit of oR Dim hx As Variant hx = 0.001 Dim dx As Variant ReDim dx(1 To 3) As Variant dx = Array(hx, 0, 0) Dim result As Variant result = Getpartialderiv_K_x_2(x, y, P, T, hx, dx) MsgBox (result(1)) End Sub
谢谢大家的帮助！ 我在本地窗口发现函数被调用后dx数组全部为零，它应该是（hx，0，0）。 出于某种原因，dx数组被强制为全零，我不知道为什么…
你的问题可能是你使用Array()填充（例如） x通过使用你重新定义的界限：
Dim x() ReDim x(1 To 3) As Variant Debug.Print LBound(x), UBound(x) '<< 1, 3 x = Array(0.4, 0.3, 0.3) Debug.Print LBound(x), UBound(x) '<< 0, 2