我在此VBA代碼中收到錯誤“類型不匹配：數組或用戶定義的類型”

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中的編程更容易，並且可能首先防止此類錯誤 - 在您的下一個項目中。

嘗試將以下內容合並到您的編程中

1. 正確縮進：每次使用編程結構時，都會包含另一個代碼塊 - 例如For ， If ， While ，將所包含的代碼塊進一步縮進一級。 例如，你的前幾行代碼應該是這樣的

   \n 對於k = 1到100\n     如果是工作表（“Sheet1”）。范圍（“A2”）。單元格（k，1）.Value <>“”那么\n         n = n + 1'計算數據點的數量\n     其他\n         退出\n     萬一\n 下一個k\n

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 ： 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