将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

问题：

我收到错误消息：＆＃34;运行时错误＆＃39; 13＆＃39;：类型不匹配＆＃34;，并使用调试器显示在以下代码行中：

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

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

如果不是因为上面的文字，那么我认为它可能与我定义的参数有关...就在它的顶部那里它说{ {1}}也许它必须是别的东西。我尝试过排除故障，但它从未真正起作用:(

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

P.S。 我需要使用这种方法的原因是因为我在给定某个点x，y（O9，P9）时试图计算2个杆的角度。我需要这些角度来计算两根棍子的质心。一旦我拥有了质量中心，我就可以完成我正在进行的项目的计算。我知道还有其他（更好的）方法来解决这个问题，比如wolfram mathematica，但是项目的其他部分需要在excel上。因此，为了尽可能顺利地运行一切，遗憾的是，我需要在excel上完成所有这些工作。

P.P.S。 顺便说一句，这不是我的代码，我是从Here复制的，但我认为它实际上解决了Newton Raphson方法。

解决方案

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

如果我能想出一个更好的方法来编写Newton Raphson方法，我一定会发一篇关于它的新帖子。

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属性的有效语法，除非您的Range具有名称“Cos（x） ）”。另外，请检查我的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