vba下标错误

更新：我一直在阅读一些网站和论坛有关在subs和函数之间传递数组。 但是这让我想到了我的variables声明是否是问题？ 目前我所有的数组（结果1,2,3，FinalResults，X和Y）都被声明为变体。 我认为这可能会导致在函数之间传递数组时发生问题。 任何人都知道这个问题是否属于我的代码？ 此外，只是为了澄清我希望结果1,2,3中的值传递给函数。

当我尝试在VBA中运行以下function时，我不断收到“下标超出范围”。 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（）variables。 我把代码的一部分包含在我的子函数中，请看一下。

 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 – 这是目前我如何select哪些数组来巩固和显示在我的结果。 我有3个searchvariables（Results1,2和3），如果只select1，显示它很容易。 然而取决于select哪个variables，我还需要合并数组（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)期望1维数组

但是， Application.Match(X(xcount, 1), Y, 0)意味着两个或多个维度（ , 1比特）。 这是由错误支持的，如果X实际上是二维的，将会返回错误。

当代码运行和错误时，请在监视窗口中检查X以确定它的真实forms

编辑请参阅Phydaux的评论 – LBound(X)默认为multidimensional array的维1。

EDIT2

两个潜在的问题：

如果P1B1或P2B1 = FALSE ，或者在数据中找不到匹配，那么P1B1或P2B1不会被P2B1 。 在未调整的数组上调用LBound或UBound将导致错误

相信与否，在一维数组上调用X（xcount，1）的错误。 但是因为On Error Resume Next处于活动状态，所以不会报告错误。

所以，你需要：

• 处理X或Y没有标注的情况

• 从X(xcount, 1)删除,1 X(xcount, 1)

我build议你看看Chip Pearson的数组处理代码的优秀网站

Answer 2

听起来像X不是一个数组：尝试显示VBE本地窗口，看看X真的是什么

Answer 3

on error resume next编程可能很难debugging。 这部分代码将只适用于一个错误发生。

 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之前添加日志logging来扩展此方法，例如：

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

Answer 4

要检查你的match奏效，你最好使用：

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

取决于你是否也需要testing你的t> 0

Answer 5

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

我添加了一个函数来检查数组是否被分配

 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