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

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

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

1 个答案: