将 Newton Raphson 方法实现到 vba 时出错

Question

我知道这是一篇很长的文章，但我非常感谢您的帮助。 我正在尝试将Newton Raphson method 编码为 VBA，代码如下所示：

代码：

'Code illustrating Newton-Raphson scheme for the equation:
' f(x) = arcCos((x-BCos(H))/S)-arcSin((Bsin(H)-y)/S)

Const ep = 1E-23: Const imax = 100
Private x As Long: Private xnew As Single: Private xl As Single
Private xu As Single: Private xm As Single: Private xmold As Single: Private A As Single: Private B As Single
Private C As Single: Private D As Single
Private i As Integer
Private Failed As Boolean: Private Converged As Boolean

Sub Setup()
Failed = False
Converged = False
i = 0
End Sub

Sub NRRoot()
Set sht = Sheets("Sheet1")
For rw = 2 To 3601

x = sht.Cells(rw, 48)

Setup
Do
Dim fx As Single: Dim fprimex As Single
fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))
fprimex = -(Range("AI5") * Sin(x) * Range("AL5")) / (Range("AL5") * Sqr((Range("AL5") ^ 2) - (Range("O9") ^ 2) + 2 * Range("O9") * Range("AI5") * Cos(x) - (Range("AI5") ^ 2) * (Cos(x) ^ 2))) - (Range("AI5") * Cos(x) * Range("AL5")) / (Range("AL5") * Sqr((Range("AL5") ^ 2) - (Range("AI5") ^ 2) * (Sin(x) ^ 2) + 2 * Range("P9") * Range("AI5") * Sin(x) - (Range("P9") ^ 2)))
xnew = x - fx / fprimex
Dim er As Single
er = Abs(2 * (xnew - x) / (xnew + x))
If er < ep Then
Converged = True
ElseIf i >= imax Then
Failed = True
Else
i = i + 1
x = xnew
End If
Loop Until Converged Or Failed
If Failed Then
sht.Cells(rw, 50).Value = "Iteration failed"
Else
sht.Cells(rw, 50).Value = xnew
End If
sht.Cells(rw, 51).Value = i
Next

End Sub

问题：

我收到错误消息：“运行时错误'13'：类型不匹配”，并使用调试器显示在这行代码中：

fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))

我认为这与Application.Acos 和Application.Asin 有关，但我不太确定。我遇到了一段时间的麻烦，我做了一些搜索，发现This 表明我必须输入Application.Acos 或Application.WorksheetFunction。输入的值都是从 -pi 到 pi 的弧度。

如果不是因为上面的文字，那么我认为它可能与我正在定义的参数有关...就在顶部它说Private x As Long也许它必须是别的东西。我尝试了故障排除，但它从未真正奏效:(

分别列出单元格O9、P9、AI5和AL5中的值：2000、3000、5700、2924.99

附： 我需要使用这种方法的原因是因为我试图在给定某个点 x,y (O9,P9) 时计算 2 根棍子的角度。我需要这些角度才能计算出两根棍子的质心。一旦我有了质心，我就可以完成我正在做的项目的计算。我知道还有其他（更好的）方法可以解决这个问题，比如 wolfram mathematica，但是项目的其他部分需要在 excel 上。因此，遗憾的是，为了让一切尽可能顺利，我需要在 Excel 上完成所有这些工作。

附言 顺便说一句，这不是我的代码，我是从Here 复制的，但我认为它确实解决了 Newton Raphson 方法。

解决方案

我有 arcSin 的数字，从 pi 开始到 -pi 而不是 90 到 -90...

如果我能找到更好的方法来编写牛顿拉夫森方法，我一定会写一篇关于它的新文章。

Answer 1

我将您的代码拆分为多个子例程并删除了一些未使用的变量。运行 Sub Main() 将给出最终结果。

VBA 本身具有 sin 和 cos 函数。您可以将它们用作VBA.sin() 和VBA.cos()，或者简单地使用sin() 和cos()。 Acos 和 Asin 包含在 Application.WorksheetFunction 中，因此您可以将它们用作 Application.WorksheetFunction.Acos 和 Application.WorksheetFunction.Asin。

在您的 fprimex 原始代码中，出现了 Range("Cos(x)")，这不是 Worksheet.Range 属性的有效语法，除非您有一个名称为“Cos(x)”的 Range。另外，请检查我的 fprimex 版本是否与您的版本相匹配，因为我已经有一段时间没有做过微积分了。

当fPrimeX = 0 或abs(x) >= 1 当sqr(1-x^2) 在分母上时，您应该小心。上述情况的粗略退出选项包含在所附代码中。

Option Explicit

Const ep As Double = 1E-23: Const iMax As Long = 100

Private FuncCoeffB As Double
Private FuncCoeffS As Double
Private FuncCoeffX As Double
Private FuncCoeffY As Double

Private sht As Worksheet
Private wksFunc As WorksheetFunction

Private Sub SetExcelVariables()
    Set sht = Application.ThisWorkbook.Worksheets(1)
    ' Set sht = Sheets("Sheet1")
    Set wksFunc = Application.WorksheetFunction
End Sub

Private Sub SetFunctionCoefficients()
    With sht
        FuncCoeffX = .Range("O9")
        FuncCoeffY = .Range("P9")

        FuncCoeffB = .Range("AI5")
        FuncCoeffS = .Range("AL5")
    End With
End Sub

Private Function fx(ArgX As Double) As Double
    Dim fx1 As Double
    Dim fx2 As Double

    If VBA.Abs((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) > 1 Or _
        VBA.Abs((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) > 1 Then

        Exit Function
    End If

    fx1 = wksFunc.Acos((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS)
    fx2 = -wksFunc.Asin((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS)

    fx = fx1 + fx2
End Function

Private Function fPrimeX(ArgX As Double) As Double
    Dim fPrimeX1 As Double
    Dim fPrimeX2 As Double

    If (((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) ^ 2) >= 1 Or _
        (((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) ^ 2) >= 1 Then

        Exit Function
    End If

    fPrimeX1 = _
        -FuncCoeffB / FuncCoeffS * VBA.Sin(ArgX) / _
        VBA.Sqr( _
            1 - ((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) ^ 2)

    fPrimeX2 = _
        -FuncCoeffB / FuncCoeffS * VBA.Cos(ArgX) / _
        VBA.Sqr( _
            1 - ((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) ^ 2)

    fPrimeX = fPrimeX1 + fPrimeX2
End Function

Private Function NewtonRaphson(ByVal ArgX As Double) As Variant
    Dim ResFx As Double
    Dim ResFPrimeX As Double

    Dim xNew As Double
    Dim er As Double

    Dim iIter As Long
    Dim Converged As Boolean
    Dim Failed As Boolean

    Dim ReturnValue As Variant
    ReDim ReturnValue(1 To 1, 1 To 2) ' An array with a size of 1-by-2.

    Do
        ResFx = fx(ArgX)
        ResFPrimeX = fPrimeX(ArgX)

        If ResFPrimeX = 0 Then
            Failed = True
        Else
            xNew = ArgX - ResFx / ResFPrimeX
        End If

        If xNew + ArgX = 0 Then
            Failed = True
        Else
            er = VBA.Abs(2 * (xNew - ArgX) / (xNew + ArgX))
        End If

        If er < ep Then
            Converged = True
        ElseIf iIter >= iMax Then
            Failed = True
        Else
            iIter = iIter + 1
            ArgX = xNew
        End If
    Loop Until Converged Or Failed

    If Failed Then
        ReturnValue(1, 1) = "Iteration failed"
    Else
        ReturnValue(1, 1) = xNew
    End If

    ReturnValue(1, 2) = iIter

    NewtonRaphson = ReturnValue
End Function

Sub Main()
    Dim rw As Long
    Dim rngTarget As Excel.Range
    Dim rngResult As Excel.Range
    Dim xValue As Double

    Call SetExcelVariables
    Call SetFunctionCoefficients

    For rw = 2 To 12
        Set rngTarget = sht.Cells(rw, 48)
        xValue = rngTarget.Value

        Set rngResult = rngTarget.Offset(0, 2).Resize(1, 2)
        rngResult.Value = NewtonRaphson(xValue)
    Next rw
End Sub