#VALUE ошибка при попытке вывода значения в ячейку excel VBA

Question

Я написал макрос, который вычисляет значения x и y. У меня возникли проблемы с попыткой записать эти значения в ячейки Excel.

Я получаю ошибку #VALUE при попытке отобразить значения на ячейке.

Я добавил свой код ниже. Любое предложение о том, что не так с кодом, будет действительно полезно и оценено?

Заранее благодарен!

'Compute Points 
Function ComputePoints(x1, y1, x2, y2, distance) As Double 

'Calculate slope m 
Dim m As Double 
m = (y2 - y1)/(x2 - x1) 

'Calculate intercept 
Dim Intercept As Double 
Intercept = y1 - m * x1 

'Calculate x for distFinal 
Dim message As String 
Dim a As Double 
Dim b As Double 
Dim c As Double 
Dim root1 As Double 
Dim root2 As Double 
Dim det As Double 
Dim det1 As Double 

Dim wb As Workbook 
Dim ws As Worksheet 
Dim x1Rng As Range 
Dim x2Rng As Range 
Dim yRng As Range 

a = (m^2 + 1) 
b = 2 * (Intercept * m - m * y2 - x2) 
c = x2^2 + (Intercept - y2)^2 - distance^2 

det = ((b^2) - (4 * a * c)) 

det1 = Sqr(det) 

message = "There is no solution to your equation" 

If det < 0 Then 
    MsgBox message, vbOKOnly, "Error" 
Else 
    root1 = Round((-b + det1)/(2 * a), 2) 
    root2 = Round((-b - det1)/(2 * a), 2) 
End If 

'Compute y 
Dim y As Double 
y = m * root2 + Intercept 

' Trying to set cell values to root1, root2, y 
Set wb = ActiveWorkbook 
Set ws = wb.Sheets("Sheet9") 

Set x1Rng = ws.Range("N2") 
Set x2Rng = ws.Range("O2") 
Set yRng = ws.Range("P2") 

x1Rng.Value2 = root1 
x2Rng.Value2 = root2 
yRng.Value2 = y 

ComputePoints = y 

End Function 

Answer 1

Я немного изменил ваш код, чтобы получить значения непосредственно в ячейках excel. Вы должны выбрать 3 горизонтальные ячейки, нажмите F2/= введите формулу, а затем нажмите Ctrl СдвигВведите, чтобы сделать его array formula.

Это даст вам три выходных значения в ячейках.

Function ComputePoints(x1, y1, x2, y2, distance) 

    Dim results(3) As Variant ' @nightcrawler23 

    'Calculate slope m 
    Dim m As Double 
    m = (y2 - y1)/(x2 - x1) 

    'Calculate intercept 
    Dim Intercept As Double 
    Intercept = y1 - m * x1 

    'Calculate x for distFinal 
    Dim message As String 
    Dim a As Double 
    Dim b As Double 
    Dim c As Double 
    Dim root1 As Double 
    Dim root2 As Double 
    Dim det As Double 
    Dim det1 As Double 

    a = (m^2 + 1) 
    b = 2 * (Intercept * m - m * y2 - x2) 
    c = x2^2 + (Intercept - y2)^2 - distance^2 

    det = ((b^2) - (4 * a * c)) 

    det1 = Sqr(det) 

    message = "There is no solution to your equation" 

    If det < 0 Then 
     MsgBox message, vbOKOnly, "Error" 
    Else 
     root1 = Round((-b + det1)/(2 * a), 2) 
     root2 = Round((-b - det1)/(2 * a), 2) 
    End If 

    'Compute y 
    Dim y As Double 
    y = m * root2 + Intercept 

    results(1) = root1 ' @nightcrawler23 
    results(2) = root2 ' @nightcrawler23 
    results(3) = y  ' @nightcrawler23 

    ComputePoints = results ' @nightcrawler23 

End Function 

Вам нужно добавить код для сообщения вывода ошибок, когда нет корней не найдены