将牛顿拉夫森法应用于vba时的误差
我知道这是一个很长的时间，但我真的很感激你的帮助。我试图将牛顿拉夫森法编码为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有关，但我不太确定。有一段时间我在它上遇到了麻烦，我做了一些搜索，发现了这，表明我必须把Application.Acos或Application.WorksheetFunction。输入的值都是以弧度表示，从-pi到pi。
如果不是因为上面的文字，那么我认为它可能与我定义的参数有关.在顶部，上面写着Private x As Long，也许它必须是其他的东西。我试过排除故障，但它从未真正起作用：
分别列出了单元格O9、P9、AI5和AL5中的值: 2000、3000、5700、2924.99。
我之所以需要使用这个方法，是因为当给定一个点x，y (O9，P9)时，我试图计算2支的角度。我需要这些角度才能计算出这两根棒的质量中心。一旦我有了质心，我就可以完成我正在做的项目的计算。我知道还有其他(更好的)方法来解决这个问题，比如，但是这个项目还有其他部分需要放在excel上。因此，为了尽可能顺利地运行一切，可悲的是，我需要在excel上完成所有这些工作。
顺便说一句，这不是我的代码，我是从这里复制的，但是我认为它确实解决了牛顿拉夫森方法。
解决方案
我有arcSin的号码，从pi开始，然后去-pi，而不是90到-90.
如果我能找到一个更好的方法来编程牛顿拉夫森方法，我肯定会做一个关于它的新帖子。
回答 1
Stack Overflow用户
发布于 2018-06-13 20:46:09
我将您的代码拆分成多个子程序，并删除了一些未使用的变量。运行Sub ()将给出最终结果。
VBA本身具有sin和cos函数。您可以使用它们作为VBA.sin()和VBA.cos()，或者简单地使用sin()和cos()。Application.WorksheetFunction中包含了Acos和Asin，因此您可以使用它们作为Application.WorksheetFunction.Acos和Application.WorksheetFunction.Asin。
在fprimex的原始代码中，出现了Range("Cos(x)")，这不是Worksheet.Range属性的有效语法，除非您有一个名为"Cos(x)“的范围。此外，请检查我的版本的fprimex是否符合您的，因为我已经有一段时间没有做微积分了。
当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 Subhttps://stackoverflow.com/questions/50842666
复制相似问题
腾讯云开发者
