Option Explicit
Sub main()
    Dim [系数],result,output,i
    [系数] = Split(InputBox("方程系数：",,"1 45 870 9450 63273 269325 723680 1172700 1026576 362880")," ")
    result = [主函数]([系数])
        For i = 0 To UBound(result)
            result(i)=round(result(i),12)
        Next
    output = ""
    If UBound(result) > 0 Then
        For i = 0 To UBound(result)
            output = output & "x" & i + 1 & "=" & result(i) & vbCrLf
        Next
    ElseIf UBound(result) =  - 1 Then
        output = "无解"
    Else
        output = "x=" & result(0)
    End If
    MsgBox output
End Sub
Call main

Function [主函数]([系数])
    Dim [解],[导数],[极值],p,arr
If UBound([系数]) = 1 Then '一次
    [解] = Array(-[系数](1)/[系数](0))
ElseIf UBound([系数]) = 0 Then
    If [系数](0) = 0 Then
        [解] = Array("所有实数")
    Else
        [解] = Array()
    End If
Else
    '高次
    [导数] = [求导]([系数])
    [极值] = [主函数]([导数])'x坐标
    If UBound([极值]) =  - 1 Then
        [解] = Array(0)' 此时一定是奇数次幂函数
    Else
        Set arr = CreateObject("System.Collections.ArrayList")
        For Each p In [极值]
            arr.add([求值]([系数],p))'arr是极值点的y
        Next
        arr = arr.toarray()
        Set [解] = CreateObject("System.Collections.ArrayList")
        If UBound([系数]) Mod 2 = 0 Then
            If [系数](0) > 0 Then
                If arr(0) <= 0 Then  [解].add([极值](0) - 1)
            Else
                If arr(0) >= 0 Then  [解].add([极值](0) - 1)
            End If
            For p = 0 To UBound(arr) - 1
                If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
            Next
            If [系数](0) > 0 Then
                If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
            Else
                If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
            End If
        Else
            If [系数](0) > 0 Then
                If arr(0) >= 0 Then  [解].add([极值](0) - 1)
            Else
                If arr(0) <= 0 Then  [解].add([极值](0) - 1)
            End If
            For p = 0 To UBound(arr) - 1
                If Sgn(arr(p)) <> Sgn(arr(p + 1)) Then [解].add(([极值](p) + [极值](p + 1)) / 2)
            Next
            If [系数](0) > 0 Then
                If arr(UBound(arr)) <= 0 Then [解].add([极值](UBound([极值])) + 1)
            Else
                If arr(UBound(arr)) >= 0 Then [解].add([极值](UBound([极值])) + 1)
            End If
        End If
        [解] = [解].toarray()
    End If
    Dim i,k,j,l,b
    For i = 0 To UBound([解])
        k = [解](i)
        l=0'计数器 防止莫名其妙迭代不出
        Do
            j = k
            k = j - [求值]([系数],j) / [求值]([导数],j)
            If Abs(j - k) < 1 * 10 ^ (-15) or l>50 Then
                k = Round(k,15)
                Exit Do
            End If
l=l+1
        Loop
        [解](i) = k
    Next
End If
[主函数] = [解]
End Function
Function [求导]([系数]) '幂函数
Dim arr,k,i
Set arr = CreateObject("System.Collections.ArrayList")
k = UBound([系数])
For i = 0 To UBound([系数]) - 1
    arr.add([系数](i) * (k - i))
Next
[求导] = arr.toarray()
End Function

Function [求值]([系数],[变量])
Dim k,j,i
k = UBound([系数])
j = 0
For i = 0 To UBound([系数])
    j = j + [变量] ^ (k - i) * [系数](i)
Next
[求值] = j
End Function
复制代码