尝试将值输出到单元格excel VBA时出现#VALUE错误

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 Shift 输入使其成为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

当找不到根时，您需要添加一些代码以输出错误消息