ОБНОВЛЕНИЕ: я читал некоторые сайты и форумы о передаче массивов между подпрограммами и функциями. Но это заставило меня задуматься о том, были ли мои объявления переменных проблемой? В настоящее время все мои массивы (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 переменные поиска (результаты 1, 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