请教一个有关range操作和求根的问题（已上传测试文件）

书生春秋

这个问题很有实际意义，发上来求助各位老师。

关于求根的问题，搜索过版面，有几个帖子讨论过，但是一直没有很好的解决。
希望能有一个函数，可以像matlab里的roots一样，方便求解所有根。
excel里对多项式处理的函数似乎很好，只知道有个多项式拟合的函数。
没用过也不熟悉，加上数学功底差，不能确定是不是可以用来解决求根的问题
但是我觉得VBA一定是有办法解决这个问题的，因此求各位熟悉VBA的高手，不吝赐教，小弟拜谢！

已经实现功能的部分代码

1. 
   
2. Public leng As Integer
   
3. Public data As Variant
   
4. Public datas As Variant
   
5. 
   
6. Private Sub inputdata_Click() '输入系数 按钮
   
7. Dim i As Integer
   
8. Dim fc As String
   
9. fc = "所求解的方程表达式为："
   
10. Do
    
11. doo: datas = InputBox("请按降幂输入特征方程系数,用英文逗号分开", "提示:必须输入正数" _
    
12. & "如：1,3,3,2", "1,3,3,2")
    
13. data = Split(datas, ",")
    
14. leng = UBound(data)
    
15. If (StrPtr(datas) = 0) Or leng < 2 Then '????
    
16. MsgBox "无效输入统", 0 + 64, "提示"
    
17. Exit Sub
    
18. Else
    
19. If datas <> "" Then Exit Do
    
20. End If
    
21. Loop
    
22. Range(Cells(7, leng + 1), Cells(8, 256)).ClearContents
    
23. Cells(7, 1) = "方程系数"
    
24. Cells(8, 1) = "方程的根"
    
25. For i = 0 To leng
    
26. Cells(7, i + 2) = data(i)
    
27. If i = 0 Then
    
28. fc = fc & Str(data(i)) & "*X^" & Str(leng)
    
29. Else
    
30. fc = fc & "+" & Str(data(i)) & "*X^" & Str(leng - i)
    
31. End If
    
32. Next
    
33. Cells(10, 1).Clear
    
34. Cells(10, 1) = fc
    
35. End Sub
    
36. Private Sub newin_Click() '在新窗口中显示 按钮
    
37. '将区域Range(Cells(6, 1), Cells(7, leng + 2))在新窗口里显示
    
38. End Sub
    
39. Private Sub roots_Click() '求根 按钮
    
40. '解出cells(10,1)单元格的方程，并将所有根写入第8行
    
41. End Sub
    
42. 
    

复制代码

多项式求根.rar (10.55 KB, 下载次数: 20)

2011-9-28 11:52 上传

点击文件名下载附件

蓝桥玄霜

可用照相机功能试试。
楼主的要求还是不太明确。

张三李四

楼主的要求是不是有点电视机的画中画？

doitbest

listview spreadsheet等都可实现

书生春秋

谢谢各位老师，1楼上传了问题说明

书生春秋

蓝桥玄霜 发表于 2011-9-27 09:25
可用照相机功能试试。
楼主的要求还是不太明确。

上传了说明，见到蓝版主真亲切
上次就是您帮我解决了一个图表显示的问题

还有个问题一并问了：在VBA里怎么求解一元高次方程的解？
比如求问题中定义的函数y=0的所有x的值

wpxxsyzx

蓝桥玄霜 发表于 2011-9-27 09:25
可用照相机功能试试。
楼主的要求还是不太明确。

版主能详细说下怎么使用照相机功能吗？

蓝桥玄霜

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B5", "B7:F7")) Is Nothing Then Exit Sub
[d5] = [b7] * [b5] ^ 4 + [c7] * [b5] ^ 3 + [d7] * [b5] ^ 2 + [e7] * [b5] + [f7]
End Sub
附件中的问题是求y的值，不是求x。
求解一元高次方程的解，可画出函数的图形，与x轴相交的即是解。

香川群子

Excel 中对函数求解，有一个自动猜数字的Goal Seek方法。

录制代码如下：
Sub Macro1()
    ActiveCell.GoalSeek Goal:=0, ChangingCell:=ActiveCell.Offset(0, -1)
    ActiveCell.Offset(1, 0).Select
End Sub

这样得到的数值，有时可能误差还是很大。

于是，用逐位测试结果比较的方法，可以较为精确地得到模拟解。

Sub gs()
    Set x = ActiveCell
    Set y = ActiveCell.Offset(0, 1)
    x0 = x.Value
    t0 = Abs(y)
    If InStr(x, ".") = 0 Then
        If x > 0 Then s = x & "." Else s = "-" & (-x - 1) & "."
    Else
        s = Left(x, Len(x) - 1) & (Right(x, 1) - 1)
    End If
    t = Abs(y * 2)
    For i = 1 To 8
        k = 0
        For j = 0 To 9
            x.Value = Val(s & j)
            If Abs(y) < t Then
                t = Abs(y)
                k = j
            End If
        Next
        s = Left(x, Len(x) - 1) & k
        If InStr(s, "E") Then GoTo Ext
        x.Value = Val(s)
    Next
Ext:
    If t0 <= Abs(y) Then x.Value = x0
'    ActiveCell.Offset(1, 0).Select
End Sub

目前求解方法是假定y函数在小区间内单向增减，求y为最小值时的x值。

香川群子

Excel 中对函数求解，有一个自动猜数字的Goal Seek方法。

录制代码如下：
Sub Macro1()
    ActiveCell.GoalSeek Goal:=0, ChangingCell:=ActiveCell.Offset(0, -1)
    ActiveCell.Offset(1, 0).Select
End Sub

这样得到的数值，有时可能误差还是很大。

于是，用逐位测试结果比较的方法，可以较为精确地得到模拟解。

Sub gs()
    Set x = ActiveCell
    Set y = ActiveCell.Offset(0, 1)
    x0 = x.Value
    t0 = Abs(y)
    If InStr(x, ".") = 0 Then
        If x > 0 Then s = x & "." Else s = "-" & (-x - 1) & "."
    Else
        s = Left(x, Len(x) - 1) & (Right(x, 1) - 1)
    End If
    t = Abs(y * 2)
    For i = 1 To 8
        k = 0
        For j = 0 To 9
            x.Value = Val(s & j)
            If Abs(y) < t Then
                t = Abs(y)
                k = j
            End If
        Next
        s = Left(x, Len(x) - 1) & k
        If InStr(s, "E") Then GoTo Ext
        x.Value = Val(s)
    Next
Ext:
    If t0 <= Abs(y) Then x.Value = x0
'    ActiveCell.Offset(1, 0).Select
End Sub

目前求解方法是假定y函数在小区间内单向增减，求y为最小值时的x值。