我在此VBA代码中收到错误"Type mismatch: array or user-defined type expected"



我在称为NLRegress的子例程上遇到错误。我认为数组类型与在子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

这个答案可能无法解决您的问题(请参阅我的评论) - 但是让我为您提供一些最佳实践,以使VBA中的编程变得更加容易,并且可能会在第一个中阻止此类错误地点 - 在您的下一个项目中。

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

  1. 适当的缩进:每次使用编程结构时,封闭了另一个代码块 - 例如ForIfWhile,缩进封闭的代码块一个级别。例如。您的前几行代码应该看起来像
    对于k = 1至100    如果工作表(" sheet1")。范围(" a2")。单元格(k,1).value&lt;>"然后        n = n   1'计数数据点的数量    别的        退出    万一下一个k
  2. 您已经在使用Option Explicit,这很棒。但是,您还应在过程/函数调用中正确地正确 Dim,例如Sub Fitted_Data(yf as Double, ...)
  3. 您在主要过程中总共使用了12个变量。这是一个非常有力的指标,您的日常工作太多了!最好将其分解为小子例程,并可能使用一些模块宽变量 - 请参见下面的示例。
  4. 变量名称绝对毫无意义 - 这很难为您调试 - 局外人几乎不可能了解您的代码在做什么。
  5. afaik您的前25行"仅"将两个范围分配给一个数组,并检查它们是否相同。使用语法x = StartRange.Resize(NumberOfRows).Cells,您可以使用较少的代码实现此目的 - 并且执行得更快。
    同一件事会找到第一个空白行 - 而不是循环,使用StartRange.End(xlDown)-这将返回您的最后一个非蓝色行!
    另外,如果您想将数组分配到一个范围,它也可以用:StartRange.Resize(NumberOfRows) = x
  6. 硬编码Worksheets("Sheet1").Range("A2")将在用户更改工作表结构时会导致问题,例如重命名表或插入行/列。最好分配单元格A2和B2名称,例如StartVector1,然后使用Range("StartVector1")访问它们。更健壮的 - 您的代码较少杂乱
  7. "不要重复自己"()。如果您看到自己两次执行相同的代码,请将其作为一个单独的过程 - 例如,您的代码数以计算数据点的数量
  8. 无需使用Call Sub(x, y) -Sub x, y等于vba
  9. 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

相关内容

最新更新