arrays - vba下标错误

Question

更新:我一直在阅读一些关于在子和函数之间传递数组的网站和论坛。但这让我开始思考我的变量声明是否是问题所在？目前我所有的数组(Results1、2、3、FinalResults、X 和 Y)都被声明为变体。而且我认为这在函数之间传递数组时可能会导致问题。任何人都知道这个问题是否与我的代码有关？另外，为了澄清我希望将 Results1、2、3 中的值传递给函数。

当我尝试在 VBA 中运行以下函数时，我不断收到“下标超出范围”。 X 和 Y 都是一维数组，我试图将数据合并到一个新数组中。当我尝试为数组 X 指定下限和上限时会发生错误。

Function lnArray(X() As Variant, Y() As Variant) As Variant
Dim counter1 As Long
Dim xcount As Long
Dim t As Long
Dim FinalResults() As Variant

counter1 = 0
    For xcount = LBound(X) To UBound(X)
        On Error Resume Next
        t = Application.Match(X(xcount, 1), Y, 0)
        If Err.Number = 0 Then
            If (t > 0) Then
                counter1 = counter1 + 1
                ReDim Preserve FinalResults(counter1)
                FinalResults(counter1) = X(xcount, 1)
            End If
        End If
        On Error GoTo 0
    Next xcount

lnArray = FinalResults
End Function

更新 - 这是我现在拥有的当前代码，我做了一些更正。即确保数组通过引用传递给函数，并将所有内容更改为一维数组。然而，同样的问题仍然存在。我已经检查过，我的 Results1() 和 Results2() 数组都存储了值，但它没有被传递给我的 UDF X() 和 Y() 变量。我在我的子代码中包含了传递函数的部分代码，请看一下。

Sub search()
Dim Results1() As Variant, Results2() As Variant, FinalResults() As Variant

        FinalResults = lnArray(Results1, Results2)
End Sub

Function lnArray(ByRef X() As Variant, ByRef Y() As Variant) As Variant
Dim counter1 As Long
Dim xcount As Long
Dim t As Long
Dim FinalResults() As Variant

counter1 = 0
    For xcount = LBound(X) To UBound(X)
        On Error Resume Next
        t = 0
        t = Application.Match(X(xcount), Y, 0)
        If Err.Number = 0 Then
            If (t > 0) Then
                counter1 = counter1 + 1
                ReDim Preserve FinalResults(counter1)
                FinalResults(counter1) = X(xcount)
            End If
        End If
        On Error GoTo 0
    Next xcount

lnArray = FinalResults
End Function

编辑 - 以下是我为 Results1() 和 Results2() 数组填充数据的方式。如果需要更多信息，请告诉我。

Sub Search()

Dim TextBox1 As Long
Dim TextBox3 As Long
Dim Results1() As Variant
Dim Results2() As Variant
Dim FindRange1 As Range
Dim Find1 As Range
Dim FindRange2 As Range
Dim Find2 As Range
Dim i1 As Long
Dim i2 As Long

TextBox1 = ILsearch.TextBox1.Value
TextBox3 = ILsearch.TextBox3.Value

 Set FindRange1 = Worksheets("Properties").Range("P7:P1000")
            If ILsearch.P1B1.Value = True Then
                For Each Find1 In FindRange1
                    If (Find1.Value < TextBox1) And (Find1.Value > 0) Then
                        i1 = i1 + 1
                        ReDim Preserve Results1(i1)
                        Results1(i1) = Find1.Address
                    End If
                Next Find1
            End If

 Set FindRange2 = Worksheets("Properties").Range("P7:P1000")
            If ILsearch.P2B1.Value = True Then
                For Each Find2 In FindRange2
                    If (Find2.Value < TextBox3) And (Find2.Value > 0) Then
                        i2 = i2 + 1
                        ReDim Preserve Results2(i2)
                        Results2(i2) = Find2.Address
                    End If
                Next Find2
            End If
End Sub

Edit2 - 这就是我目前选择合并哪些数组并在我的结果中显示的方式。我有 3 个搜索变量(Results1,2 和 3)，如果只选择了 1 个，则显示它很容易。但是，根据选择的变量，我还需要合并数组(1+2,1+3,2+3，或所有 3 个数组)。我意识到它可能是多么困惑和低效，但我想不出更好的方法。

'For a single property selection
Dim p1results As Range
Dim shProperties As Worksheet
Dim shSearchResult As Worksheet

Set shProperties = ActiveWorkbook.Worksheets("properties")
Set shSearchResult = ActiveWorkbook.Worksheets("searchresult")

If (ILsearch.ComboBox1.Enabled = True) And (ILsearch.ComboBox2.Enabled = False) And (ILsearch.ComboBox3.Enabled = False) Then
   On Error Resume Next
   For i1 = LBound(Results1) To UBound(Results1)
        Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, -3)
        shProperties.Range(Results1(i1)).EntireRow.Copy NextRow
    Next i1
End If

'repeat same if/then code for Results2 and Results3

Dim FinalResults() As Variant
Dim FinCount As Integer
Dim Counter1 As Long
Dim t As Long

If (ILsearch.ComboBox1.Enabled = True) And (ILsearch.ComboBox2.Enabled = True) And (ILsearch.ComboBox2.Enabled = False) Then
    If IsArrayAllocated(Results1) = True And IsArrayAllocated(Results2) = True Then
    Else
         Debug.Print "Empty Array"
    End If

    FinalResults = lnArray(Results1, Results2)
        On Error Resume Next
        For FinCount = LBound(FinalResults) To UBound(FinalResults)
            Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, -3)
            shProperties.Range(Results3(i3)).EntireRow.Copy NextRow
        Next FinCount
End If
'repeat same if/then for (1+3) arrangement and (2+3)arrangement

Dim intResults() As Variant

If (ILsearch.ComboBox1.Enabled = True) And (ILsearch.ComboBox2.Enabled = True) And (ILsearch.ComboBox2.Enabled = True) Then
intResults = lnArray(Results1, Results2)
FinalResults = lnArray(intResults, Results3)
    On Error Resume Next
    For FinCount = LBound(FinalResults) To UBound(FinalResults)
        Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, -3)
        shProperties.Range(Results3(i3)).EntireRow.Copy NextRow
    Next FinCount
End If

Answer 1

您的代码中有一条混合消息:

你说，你的代码行For xcount = LBound(X) To UBound(X)需要一维数组

但是，Application.Match(X(xcount, 1), Y, 0)意味着两个或多个维度(, 1 位)。错误支持这一点，如果 X 实际上是二维的，则会返回该错误。

当代码运行并出错时，检查观察窗口中的 X 以确定其真实形式

编辑
见 Phydaux 的评论 - LBound(X)默认为多维数组的维度 1。

编辑2

两个潜在问题:

如果 P1B1或 P2B1 = FALSE ，或在数据中找不到匹配项，则 Results1或 Results2分别从不标注尺寸。调用LBound或 UBound在无维数组上会导致错误

信不信由你，在一维数组上调用 X(xcount, 1) 错误。但是自从On Error Resume Next处于事件状态，不报告错误。

因此，您需要:

处理 X 或 Y 未标注尺寸的情况

放弃,1来自 X(xcount, 1)

建议你看看Chip Pearson的数组处理代码的优秀站点