Question

我在名为NLRegress的子程序中收到错误。我认为数组类型与Sub NLRegress中第一次调用中的数组类型不同。 Z矩阵是以下数组[1,0.2,0.04：1,0.5,0.25：1,0.8,0.64：1,1.2,1.44：1,1.7,2.89：1,2,4]

这是我的代码：

Option Explicit
Option Base 1
Sub Main()

    Dim x() As Double, y() As Double, n As Integer, p As Integer, _
    a() As Double, syx As Double, r2 As Double, m As Integer, _
    yf() As Double, Z() As Double

    Dim i As Integer, k As Integer
    For k = 1 To 100
    If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
        n = n + 1 'counts the number of data points
    Else
        Exit For
    End If
    Next k
    For k = 1 To 100
    If Worksheets("Sheet1").Range("B2").Cells(k, 1).Value <> "" Then
        p = p + 1 'counts the number of data points
    Else
        Exit For
    End If
    Next k
    If p = n Then
    p = n
    ReDim yf(n)
    Else: MsgBox ("Unequal number of x and y values")
    End If
    ReDim x(n)
    ReDim y(n)
    For i = 1 To n 'Read data for matrix x
            x(i) = _
            Worksheets("Sheet1").Range("A2").Cells(i, 1).Value
    Next
    For i = 1 To n 'Read data for matrix y
            y(i) = _
            Worksheets("Sheet1").Range("B2").Cells(i, 1).Value
    Next
    m = Worksheets("Sheet1").Range("E2").Value

    ReDim a(m + 1)
    Call BuildZP(x, Z, n, m)
    Call NLRegress(Z, y, a, n, m)
    Call MultiplyMatrixByVector(Z, a, yf)
End Sub
Sub Fitted_Data(yf, a, x, n)
    Dim q As Integer
    For q = 1 To n
        yf(q) = a(1) + a(2) * x(q) + a(3) * x(q) ^ 2
        Worksheets("Sheet1").Range("C2").Cells(q, 1).Value = yf(q)
    Next
End Sub
Sub NLRegress(Z, y, a, n, m)
Dim er As Double, tol As Double, ZT() As Double, ZTZ() As Double, ZTZI() As Double, ZTY() As Double
er = 0
tol = 0.0001
ReDim ZT(m + 1, n)
Call TransposeMatrix(Z, ZT)
Call MultiplyMatrices(ZT, Z, ZTZ)
Call MatrixInverse(ZTZ, ZTZI, m + 1, tol, er)
Call MultiplyMatrixByVector(ZT, y, ZTY)
Call MultiplyMatrixByVector(ZTZI, ZTY, a)
End Sub

Sub BuildZP(x, Z, n, m)
Dim i As Integer, j As Integer
ReDim Z(n, m + 1)
    For i = 1 To n
        For j = 1 To m + 1
            Z(i, j) = x(i) ^ (j - 1)
        Next j
    Next i
End Sub

Answer 1

这个答案可能无法解决您的问题（请参阅我的评论） - 但是让我尽可能地为您提供一些最佳实践，这些实践可能会使VBA中的编程变得更容易，并且可能会在您的下一个项目中首先防止此类错误。

尝试将以下内容纳入您的编程

正确缩进：每次使用编程结构时，都会包含另一个代码块 - 例如For，If，While，将所包含的代码块进一步缩进一层。例如。您的前几行代码应该看起来像
```
For k = 1 To 100
    If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
        n = n + 1    'counts the number of data points
    Else
        Exit For
    End If
Next k
```
您已使用Option Explicit，这很棒。但是，您还应该在过程/函数调用中正确Dim每个变量 - 例如Sub Fitted_Data(yf as Double, ...)
您在主程序中总共使用了12个变量。这是一个非常强大的指标，你的日常工作做得太多了！最好将其分解为小的子程序，并可能使用一些模块范围的变量 - 请参阅下面的示例。
变量名称绝对没有意义 - 这使得你很难调试 - 外人几乎不可能理解你的代码在做什么。
AFAIK您的前25行“仅”将两个范围分配给一个数组并检查它们是否大小相同。使用语法x = StartRange.Resize(NumberOfRows).Cells，您可以用更少的代码实现这一点 - 并且执行速度更快同样的事情是找到第一个空白行 - 而不是循环，使用StartRange.End(xlDown) - 这将返回最后一个非空白行！
另外，如果你想为一个范围分配一个数组，它也可以反过来：StartRange.Resize(NumberOfRows) = x。
当用户更改工作表结构时，硬编码Worksheets("Sheet1").Range("A2")会导致问题，例如重命名工作表或插入行/列。更好地分配单元格A2和B2名称，例如StartVector1然后使用Range("StartVector1")访问它们。更加健壮 - 而且您的代码不那么混乱
“不要重复自己”（ DRY ）。如果您发现自己两次执行相同的代码，请将其作为单独的过程 - 例如，计算数据点数的代码
无需使用Call Sub(x, y) - Sub x, y等同于VBA
Excel功能也可以在VBA中使用。这对于矩阵函数尤其方便。例如。要转置数组，您可以使用以下代码：transposedX = worksheetFunctions.Transpose(x)

这是前几个

Option Explicit

Private mVec1() As Double 'Better give a better name representing the target content of variable
Private mVec2() As Double 'I use m as a prefix to indicate module wide scoped variables

Public Sub SubDoingSomething() 'Use a name that tells the reader what the sub does

    LoadVectors

    BuildZP Z, n, m 'use proper variable names here

    NLRegress Z, y, a, n, m 'and maybe use some more module wide variables that you don't need to pass

    MultiplyMatrixByVector Z, a, yf

End Sub

Private Sub LoadVectors()
    Dim count1 As Long, count2 As Long

    count1 = GetRowLength(Range("StartVector1"))
    count2 = GetRowLength(Range("StartVector2"))

    If count1 <> count2 Then
        MsgBox ("Unequal number of x and y values")
        End
    End If

    mVec1 = Range("StartVector1").Resize(count1).Cells
    mVec2 = Range("StartVector2").Resize(count2).Cells

End Sub

Private Function GetRowLenght(rng As Range)
    If rng.Offset(1) = "" Then
        GetRowLength = 1
    Else
        GetRowLength = rng.End(xlDown).Row - rng.Row + 1
    End If
End Function

我在此VBA代码中收到错误“类型不匹配：数组或用户定义的类型”

1 个答案: