Функция пользователя в Excel
Добрый день, Господа!
Очень хотелось бы получить ответ на такой вопрос: Как в Excel создать функцию, которая возвращает не одно значение, а несколько. Например, функцию решения квадратного уравнения, или решения систем алгебраических уравнений.
Уже неделю бьюсь и никак не могу понять. Вот последний вариант:
Function Sq(a, b, c As Double) As Variant
Dim x1, x2, d As Double
d = b ^ 2 - 4 * a * c
If d < 0 Then
ActiveCell.Offset(1, 0).Range("A1") = "Нет корней"
Sq = "Нет корней"
Else
If d = 0 Then
x1 = -b / (2 * a)
ActiveCell.Offset(1, 0).Range("A1") = x1
Sq = x1
Else
x1 = (-b + Sqr(d)) / (2 * a)
x2 = (-b - Sqr(d)) / (2 * a)
Sq = x1
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = x2
ActiveCell.Offset(-1, 0).Range("A1").Select
End If
End If
End Function
Заранее благодарен!
Очень хотелось бы получить ответ на такой вопрос: Как в Excel создать функцию, которая возвращает не одно значение, а несколько. Например, функцию решения квадратного уравнения, или решения систем алгебраических уравнений.
Уже неделю бьюсь и никак не могу понять. Вот последний вариант:
Function Sq(a, b, c As Double) As Variant
Dim x1, x2, d As Double
d = b ^ 2 - 4 * a * c
If d < 0 Then
ActiveCell.Offset(1, 0).Range("A1") = "Нет корней"
Sq = "Нет корней"
Else
If d = 0 Then
x1 = -b / (2 * a)
ActiveCell.Offset(1, 0).Range("A1") = x1
Sq = x1
Else
x1 = (-b + Sqr(d)) / (2 * a)
x2 = (-b - Sqr(d)) / (2 * a)
Sq = x1
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = x2
ActiveCell.Offset(-1, 0).Range("A1").Select
End If
End If
End Function
Заранее благодарен!
Для возвращаемых значений можно использовать массив, добавляем его в описание функции
Function Sq(a, b, c As Double, buf As Variant) As Variant
Dim x1, x2, d As Double
d = b ^ 2 - 4 * a * c
If d < 0 Then
ActiveCell.offset(1, 0).Range("A1") = "Нет корней"
Sq = "Нет корней"
Else
If d = 0 Then
x1 = -b / (2 * a)
ActiveCell.offset(1, 0).Range("A1") = x1
Sq = x1
Else
x1 = (-b + Sqr(d)) / (2 * a)
x2 = (-b - Sqr(d)) / (2 * a)
Sq = x1
ActiveCell.offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = x2
ActiveCell.offset(-1, 0).Range("A1").Select
End If
'*****
buf(0) = x1
buf(1) = x2
'*****
End If
End Function
Вызов функции
Public Function TestSq()
Dim buf(1)
Call Sq(3, 10, 5, buf)
End Function
Function Sq(a, b, c As Double, buf As Variant) As Variant
Dim x1, x2, d As Double
d = b ^ 2 - 4 * a * c
If d < 0 Then
ActiveCell.offset(1, 0).Range("A1") = "Нет корней"
Sq = "Нет корней"
Else
If d = 0 Then
x1 = -b / (2 * a)
ActiveCell.offset(1, 0).Range("A1") = x1
Sq = x1
Else
x1 = (-b + Sqr(d)) / (2 * a)
x2 = (-b - Sqr(d)) / (2 * a)
Sq = x1
ActiveCell.offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = x2
ActiveCell.offset(-1, 0).Range("A1").Select
End If
'*****
buf(0) = x1
buf(1) = x2
'*****
End If
End Function
Вызов функции
Public Function TestSq()
Dim buf(1)
Call Sq(3, 10, 5, buf)
End Function
Спасибо за ответ. Но я нашел другой способ самостоятельно. Давно уже сделал такую функцию, просто не понимал, что данные выводятся как матрица, поэтому одномерный массив - это строка.
Function Sq(a, b, c As Double) As Variant
Dim x1 As Double, x2 As Double, d As Double
Dim rez_arr(1, 0) As Double
Dim rez_err(1, 0) As String
d = b ^ 2 - 4 * a * c
If d < 0 Then
rez_err(0, 0) = "Íåò êîðíåé"
rez_err(1, 0) = "Íåò êîðíåé"
Sq = rez_err
Else
If d = 0 Then
x1 = -b / (2 * a)
rez_arr(0, 0) = x1
rez_arr(1, 0) = x1
Sq = rez_arr
Else
rez_arr(0, 0) = (-b + Sqr(d)) / (2 * a)
rez_arr(1, 0) = (-b - Sqr(d)) / (2 * a)
Sq = rez_arr
End If
End If
End Function
При вызове функции заполняем поля и затем нажимаем CTRL+Enter.
Function Sq(a, b, c As Double) As Variant
Dim x1 As Double, x2 As Double, d As Double
Dim rez_arr(1, 0) As Double
Dim rez_err(1, 0) As String
d = b ^ 2 - 4 * a * c
If d < 0 Then
rez_err(0, 0) = "Íåò êîðíåé"
rez_err(1, 0) = "Íåò êîðíåé"
Sq = rez_err
Else
If d = 0 Then
x1 = -b / (2 * a)
rez_arr(0, 0) = x1
rez_arr(1, 0) = x1
Sq = rez_arr
Else
rez_arr(0, 0) = (-b + Sqr(d)) / (2 * a)
rez_arr(1, 0) = (-b - Sqr(d)) / (2 * a)
Sq = rez_arr
End If
End If
End Function
При вызове функции заполняем поля и затем нажимаем CTRL+Enter.