Определенная пользователем функция в VBA не работает и возвращает ноль, несоответствие типа данных

Я определяю определенную пользователем функцию следующим образом, когда я пытаюсь вызвать ее в подпрограмме, она возвращает значение «нуль», что, безусловно, неверно.

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 

Однако, когда я пытался дублировать один и тот же код, определяющий указанную выше функцию, используя подпрограмму и предоставляя одинаковые входные значения, результаты полностью соответствуют:

 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 

Я проверил тип данных, и кажется, что нет рассогласования. А также функция ThermoRel (x, y, P, T) работает отлично и имеет вариантный тип данных. Я потратил много времени и старался изо всех сил, но до сих пор не могу понять, ваши вклады будут высоко оценены !!!

Чтобы вы могли легко отладить его, я сделал виртуальный пример с теми же ошибками (выходы 0) следующим образом:

 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 

Спасибо всем за помощь! Я обнаружил в окне locals, что массив 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 
  • VBA UDF изменяет значения на всех листах. Как ограничиться одним?
  • Что означает «Microsoft Office Excel ожидает, что другое приложение завершит действие OLE»?
  • Можно ли использовать FindPrevious при поиске кода VBA в UDF?
  • UDF, ссылающийся на именованные ошибки таблицы, когда активна другая рабочая книга
  • VBA - оптимизация UDF (счетчик цветов ячеек)
  • Невозможно записать строку в ячейке из UDF
  • vsto excel: не удается выяснить, что делает Application.get_Caller (1)
  • Удалять все, кроме чисел из ячейки
  • Выберите одну ячейку в диапазоне диапазона range.cell, если она установлена ​​в UDF
  • Пересчитать при изменении фона ячейки
  • UDF: для значений ячейки меньше, чем x в столбце, возвращайте все значения из первого столбца
  • Давайте будем гением компьютера.