在vba中实现Newton-Raphson方法时出错

这是一个很长的一个我知道，但我真的很感谢你的帮助。 我正在尝试将代码编码到VBA中，代码如下所示：

代码： 我认为这与

应用程序.Acos

和

应用程序.Asin

有关，但我不太确定。我有一段时间遇到了问题，我做了一些搜索，发现我必须将

Application.Acos

或

Application.WorksheetFunction

。输入的值都是从-pi到pi的弧度

如果不是因为上面的文字，那么我认为它可能与我定义的参数有关。。。就在上面，上面写着“私人x，只要长”，可能是别的东西。我尝试过故障排除，但从未真正起作用：（

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

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

p.p.S。 顺便说一下，这不是我的代码，我从中复制了它，但是我认为它确实解决了牛顿-拉斐逊方法

解决方案 我有Arcin的数字，从π开始到-π，而不是从90到-90

---

如果我能想出一个更好的方法来编程牛顿-拉斐逊方法，我一定会发表一篇关于它的新文章。

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

VBA本身具有sin和cos函数。您可以将它们用作

VBA.sin（）

和

VBA.cos（）

，或者简单地使用

sin（）

和

cos（）

。Acos和Asin包含在

应用程序.WorksheetFunction

中，因此您可以将它们用作

应用程序.WorksheetFunction.Acos

和

应用程序.WorksheetFunction.Asin

在fprimex的原始代码中，出现了

范围（“Cos（x）”）

，这不是

工作表.Range

属性的有效语法，除非您有一个名称为“Cos（x）”的范围。另外，请检查我的fprimex版本是否与您的版本匹配，因为我已经有一段时间没有做微积分了

当分母上有

sqr（1-x^2）

时，应小心处理

fPrimeX=0

或

abs（x）>=1

的情况。上述情况的粗略退出选项包含在所附代码中

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

选项显式
常数ep为双=1E-23：常数iMax为长=100
私有funcoceffB为双精度
作为双变量的私有functcoefs
私有FuncCoeffX为双精度
二次函数
私人sht As工作表
专用wksFunc作为工作表功能
私有子集合ExcelVariables（）
Set sht=Application.ThisWorkbook.Worksheets（1）
'设置页数=页数（“第1页”）
设置wksFunc=Application.WorksheetFunction
端接头
私有子集合函数系数（）
用短发
FuncCoeffX=.Range（“O9”）
FuncCoeffY=.Range（“P9”）
FuncCoeffB=.Range（“AI5”）
funccoefs=.Range（“AL5”）
以
端接头
专用函数fx（ArgX为Double）为Double
将fx1变暗为双精度
将fx2变暗为双精度
如果VBA.Abs（（FuncCoeffX-FuncCoeffB*VBA.Cos（ArgX））/FuncCoeffS）>1或_
VBA.Abs（（-funcoceffy+funcoceffb*VBA.Sin（ArgX））/funcoceffs）>1
退出功能
如果结束
fx1=wksFunc.Acos（（funcoceffx-funcoceffb*VBA.Cos（ArgX））/funcoceffs）
fx2=-wksFunc.Asin（（-funcoceffy+funcoceffb*VBA.Sin（ArgX））/funcoceffs）
fx=fx1+fx2
端函数
专用函数fPrimeX（ArgX为Double）为Double
尺寸fPrimeX1为双精度
尺寸fPrimeX2为双精度
如果（（（funcoceffx-funcoceffb*VBA.Cos（ArgX））/funcoceffs）^2）>=1或_
（（（-funcoceffy+funcoceffb*VBA.Sin（ArgX））/funcoceffs）^2）>=1
退出功能
如果结束
fPrimeX1=_
-FuncCoeffB/FuncCoeffS*VBA.Sin（ArgX）/_
VBA.Sqr（_
1-（（funcoceffx-funcoceffb*VBA.Cos（ArgX））/funcoceff）^2）
fPrimeX2=_
-FuncCoeffB/FuncCoeffS*VBA.Cos（ArgX）/_
VBA.Sqr（_
1-（-funcoceffy+funcoceffb*VBA.Sin（ArgX））/funcoceff）^2）
fPrimeX=fPrimeX1+fPrimeX2
端函数
私有函数NewtonRaphson（ByVal ArgX作为Double）作为变量
将ResFx设置为双精度
Dim ResFPrimeX作为双
双色
双倍变暗
越暗越长
Dim收敛为布尔型
Dim作为布尔值失败
将返回值作为变量
ReDim ReturnValue（1到1，1到2）'大小为1乘2的数组。
做
ResFx=fx（ArgX）
ResFPrimeX=fPrimeX（ArgX）
如果ResFPrimeX=0，则
失败=真
其他的
xNew=ArgX-ResFx/ResFPrimeX
如果结束
如果xNew+ArgX=0，则
失败=真
其他的
er=VBA.Abs（2*（xNew-ArgX）/（xNew+ArgX））
如果结束
如果er=iMax然后
失败=真
其他的
iIter=iIter+1
ArgX=xNew
如果结束
循环直到收敛或失败
如果失败了那么
ReturnValue（1，1）=“迭代失败”
其他的
返回值（1，1）=xNew
如果结束
返回值（1，2）=iIter
NewtonRaphson=返回值
端函数
副标题（）
变暗rw为长
作为Excel.Range的Dim RNG目标
作为Excel.Range的Dim rngResult
尺寸xA值
fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))

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