vba下标错误

时间：2011-06-28 08:57:37

标签： arrays excel vba excel-vba

更新：我一直在阅读一些关于在子和函数之间传递数组的网站和论坛。但它让我思考我的变量声明是否是问题？目前我的所有数组（Results1,2,3，FinalResults，X＆amp; Y）都被声明为variant。我认为这可能会导致在函数之间传递数组时出现问题。有人知道这个问题是否与我的代码有关？另外，只是为了澄清我希望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

5 个答案:

答案 0 :(得分：2)

听起来X不是数组：尝试显示VBE Locals窗口以查看X确实是什么

答案 1 :(得分：2)

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

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

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

当代码运行并出现错误时，请在监视窗口中检查X以确定其真实形式

修改 请参阅Phydaux的评论 - LBound(X)默认为多维数组的维度1。

<强> EDIT2

两个潜在问题：

如果P1B1或P2B1 = FALSE，或者数据中未找到任何匹配项，则Results1或Results2分别从不标注尺寸。在未扩展的数组上调用LBound或UBound将导致错误

信不信由你，在一维数组上调用X（xcount，1）错误。但由于On Error Resume Next处于活动状态，因此不会报告错误。

所以，你需要：

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

  • 从,1

    • 中删除X(xcount, 1)

我建议您查看Chip Pearson数组处理代码的优秀网站

答案 2 :(得分：1)

使用on error resume next进行编程可能很难调试。 这段代码只适用于一次错误发生。

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

当第一个错误发生时，If Err.Number = 0将因所有剩余的迭代而失败。 为避免这种情况，您应该使用Err.clear

重置错误 
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 
        Err.clear 'ignore match error
    Else
        If (t > 0) Then

最后，您可以通过在Err.Clear之前添加日志记录来扩展此方法，例如：

debug.print Err.number,Err.message....

答案 3 :(得分：0)

要检查match是否有效，您最好使用：

t = Application.Match(X(xcount, 1), Y, 0)
If IsEmpty(t) Then
   counter1 = counter1 + 1
End If

取决于您是否还需要测试您的t＆gt; 0

答案 4 :(得分：0)

编辑：问题似乎是在未分配数组时可以调用该函数。如果没有匹配或ILsearch.P1B1.Value = False或ILsearch.P2B1.Value = False，则可能会发生这种情况。

我添加了一个检查if the arrays are allocated

的函数 
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
If IsArrayAllocated(Results1) = True And _
    IsArrayAllocated(Results2) = True Then
    Z = lnArray(Results1, Results2)
Else
    Debug.Print "Empty Array"
End If
End Sub


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 = 0
        t = Application.Match(X(xcount), Y, 0)
            If (t > 0) Then
                counter1 = counter1 + 1
                ReDim Preserve FinalResults(counter1)
                FinalResults(counter1) = X(xcount)
        End If
        On Error GoTo 0
    Next xcount

lnArray = FinalResults
End Function

Function IsArrayAllocated(Arr As Variant) As Boolean
'**Determines whether an array is allocated to avoid UBound errors
    On Error Resume Next
    IsArrayAllocated = IsArray(Arr) And _
                       Not IsError(LBound(Arr, 1)) And _
                       LBound(Arr, 1) <= UBound(Arr, 1)
    On Error GoTo 0
End Function
相关问题
最新问题