确定数组

时间:2016-03-07 16:46:43

标签: arrays excel vba excel-vba

我意识到,标题提示了一个简单的答案。但请仔细阅读。在我的本科学习中,我正在学习一门名为计算数学和数值分析的课程,在那里我学习C ++。现在我昨天开始在VBA编码 - 只是为了好玩。我试图制作一个可以计算多项式根的程序。经过一番来回,我已经成功地编写了所有代码。我想做的最后一件事是在Excel中打印所有根。为此,我使用了一个名为'arroot'的数组。下面的Sub是我的主要:

Sub Main()
    Dim fx As Double, Dim dffx As Double, Dim n As Integer
    Dim x As Double, Dim root As Double, Dim arroot()
    Dim a(15) As Long, Dim i As Integer

    Sheet1.Cells.ClearContents
    Call PolyCoef(n, a)
    i = 0
    Do
         Call Table(n, a, x, fx, dffx)
         Call NewRapHorner(n, a, fx, dffx, root)
         Call HornerDivPol(n, a, root)
         arroot(i) = root
         i = i + 1
    Loop While (Not n = 0)
    Call Printroot(arroot)           
End Sub

你可以看到,我正在保存数组中的值,总是更新'i'以确保我得到每个值。负责打印根目录的代码如下:

Private Sub Printroot(arroot())

    Sheet1.Range("G3").Value = "Root"
    Sheet1.Range("H3").Value = "x-value"
    For i = 0 To UBound(arroot()) Step 1
        Sheet1.Range("G" & 4 + i).Value = i + 1 & ". root"
        Sheet1.Range("H" & 4 + i).Value = arroot(i)
    Next
End Sub

我的问题:执行此操作时,我遇到了问题 - 代码无法运行。当我将数组定义为Dim arroot(15)时,代码可以工作。唯一的问题是,我打印了太多'i + 1& “。根”。我该如何解决这个问题?我希望我的数组与根数一样大。如果以这种方式使用它是有意义的:我希望数组的括号以某种方式为空,因此它会自动调整。

提前谢谢!

修改

根据要求,这是完整的代码:

Sub Main()
    Dim fx As Double, Dim dffx As Double, Dim n As Integer
    Dim x As Double, Dim root As Double, Dim arroot(15)
    Dim a(15) As Long, Dim i As Integer

    Sheet1.Cells.ClearContents
    Call PolyCoef(n, a)
    i = 0
    Do
        Call Table(n, a, x, fx, dffx)
        Call NewRapHorner(n, a, fx, dffx, root)
        Call HornerDivPol(n, a, root)
        arroot(i) = root
        i = i + 1
    Loop While (Not n = 0)
    Call Printroot(arroot)    
End Sub

'Main Ends. Subs used in main are defined:

Private Sub PolyCoef(n As Integer, a() As Long)
    Dim e As Integer

    Sheet1.Range("A1").Value = "Enter n for polynomial"
    Sheet1.Range("B1").Value = InputBox("Enter n", "Degree of the polynomial")
    n = Sheet1.Range("B1").Value
    e = n
    Sheet1.Range("A3").Value = "Coefficients:"
    Sheet1.Range("B3").Value = "Values:"

    For i = 0 To n Step 1
        Sheet1.Range("A" & i + 4).Value = i + 1 & ". coefficient, a" & e
        Sheet1.Range("B" & i + 4).Value = InputBox("Enter coefficient", i + 1 & ". coefficient")
        a(i) = Sheet1.Range("B" & i + 4).Value
        e = e - 1
    Next
End Sub


Private Sub Horner(n As Integer, a() As Long, x As Double, fx As Double, dffx As Double)
    Dim e As Integer, Dim b(15), Dim c(15)

    b(0) = a(0)
    For i = 1 To n Step 1
        b(i) = a(i) + x * b(i - 1)
    Next
    c(0) = b(0)
    For i = 1 To n Step 1
        c(i) = b(i) + x * c(i - 1)
    Next
    fx = b(n)
    dffx = c(n - 1)
End Sub

Private Sub Table(n As Integer, a() As Long, x As Double, fx As Double, dffx As Double)
    Dim xmax As Double, Dim dx As Double

    x = InputBox("Enter first x-value", "Enter xmin")
    xmax = InputBox("Enter last x-value", "Enter xmax")
    dx = (xmax - x) / 19
    Sheet1.Range("D3").Value = "x-value"
    Sheet1.Range("E3").Value = "f(x)"
    For i = 0 To 19 Step 1
        Call Horner(n, a, x, fx, dffx)
        Sheet1.Range("D" & 4 + i).Value = x
        Sheet1.Range("E" & 4 + i).Value = fx
        x = x + dx
    Next
End Sub

Private Sub NewRapHorner(n As Integer, a() As Long, fx As Double, dffx As Double, root As Double)
    Dim xnew As Double, Dim xold As Double, Dim eps As Double
    Dim ite As Integer, Dim x0 As Double, Dim i As Integer

    x0 = InputBox("Enter x-value close to root", "x-value")
    eps = InputBox("Enter tolerance", "Tolerance")
    ite = InputBox("Enter number of max iterations", "Max iterations")
    i = 0
    xnew = x0
    root = 0
    Do
        xold = xnew
        Call Horner(n, a, xnew, fx, dffx)
        xnew = xnew - (fx / dffx)
        i = i + 1
    Loop While (Abs(xnew - xold) > eps And i < ite)
    If i >= ite Then
        MsgBox "Number of max iterations has been exeeded"
    Else
        root = xnew
    End If
End Sub

Private Sub HornerDivPol(n As Integer, a() As Long, root As Double)
    Dim b(15) As Long

    b(0) = a(0)
    For i = 1 To n Step 1
        b(i) = a(i) + root * b(i - 1)
    Next   
    For i = 1 To n Step 1
        a(i) = b(i)
    Next 
    n = n - 1
End Sub

Private Sub Printroot(arroot())

    Sheet1.Range("G3").Value = "Root"
    Sheet1.Range("H3").Value = "x-value"
    For i = 0 To UBound(arroot()) Step 1
        Sheet1.Range("G" & 4 + i).Value = i + 1 & ". root"
        Sheet1.Range("H" & 4 + i).Value = arroot(i)
    Next
End Sub

1 个答案:

答案 0 :(得分:0)

对于您想要在VBA中执行的操作,数组效率不高。 我建议创建一个像:

这样的集合
Public yourArray As New Collection

添加相同类型的元素,它将动态调整其大小。下面我将展示如何向集合中添加元素。

Public yourArray As New Collection

Sub trieal()

i = 10
Do Until i = 1
    yourArray.Add i
    i = i - 1

Loop

For Each e In yourArray
    Debug.Print (e)
Next
End Sub

解决了循环遍历&#34;数组&#34;元素的问题。