Код Excel VBA для множественного просмотра

Для сети трубопроводов я пытаюсь найти трубы, ведущие к люку. Может быть несколько труб, которые могут стекать в один люк. Моя структура данных организована следующим образом:

   Stop Node    Label
  .......................
    MH-37       CO-40
    MH-37       CO-40
    MH-39       CO-43
    MH-37       CO-44
    MH-39       CO-45
    MH-41       CO-46
    MH-35       CO-47
    MH-44       CO-50
    MH-39       CO-51
    MH-44       CO-52

и так далее.

Конечно, в Excel мы можем обойти множественный вопрос vlookup, используя уравнения массива. Однако я не уверен, как это делается в кодировании Excel VBA. Мне нужно автоматизировать весь процесс и, следовательно, кодирование Excel VBA. Эта задача является частью более крупного задания.

Ниже приведен код функции, который я написал до сих пор:

Function Conduitt(M As String) As String()

Dim Stop_Node As Variant /* All Manhole label */
Dim Conduit As Variant /* All conduit label */
Dim compare As Variant /* Query Manhole label */
Dim Result() As String
Dim countc As Integer

Stop_Node = ActiveSheet.Range("B2:B73").Value
Conduit = ActiveSheet.Range("C2:C73").Value
compare = M

countc = 1

Do While countc <= 72

If Application.IsError(Application.Match(Stop_Node(countc), compare)) = 0 Then

Result(countc) = Conduit(countc)

End If

countc = countc + 1

Loop

Conduitt = Result()

End Function

Если вы сравните образец данных, который я предоставил ранее, для люка MH-39 соответствующие метки трубопровода: CO-43, CO-45 и CO-51. Я думал, что с изменением countc из-за цикла do он пройдет по списку и найдет точные совпадения для MH-39 и вернет CO-43, CO-45 и CO-51.

Цель состоит в том, чтобы возвращать эти метки каналов только в виде массива строк с тремя строками (для случая MH-39).

До сих пор, когда я запускаю код, я получаю:

Ошибка выполнения '9': нижний индекс вне допустимого диапазона.

Я искал разные форумы и обнаружил, что это происходит, когда ссылаются на несуществующие элементы массива. На данный момент мои ограниченные знания и опыт не помогают разгадать загадку.

После некоторых предложений от R3uK код был исправлен. По-видимому, при назначении диапазона вариантному массиву (как в случае с Stop_Node и Conduit) вариант будет многомерным. Итак, обновите код соответствующим образом и включите Preserve с Redim.

Если вам интересно, обновленный код:

Function Conduitt(Manhole As String) As String()

Dim Stop_Node As Variant
Dim Conduit As Variant
Dim Result() As String

ReDim Result(0)

Stop_Node = ActiveSheet.Range("B2:B73").Value
Conduit = ActiveSheet.Range("C2:C73").Value

For i = LBound(Stop_Node) To UBound(Stop_Node)
If Stop_Node(i, 1) <> Manhole Then
Else
    Result(UBound(Result)) = Conduit(i, 1)
    ReDim Preserve Result(UBound(Result) + 1)
End If
Next i
ReDim Preserve Result(UBound(Result) - 1)

Conduitt = Result

excel vlookup vba
person İmtiaz    schedule 17.06.2015    source источник
comment
Учитывая, что вы хотите вернуть значения в 3 строки, почему вы используете функцию вместо подпрограммы?   -  person Raystafarian    schedule 17.06.2015
comment
@Raystafarian: потому что у вас могут быть массивы в качестве результатов, поэтому для них проще иметь функцию.   -  person R3uK    schedule 17.06.2015
comment
Знаете ли вы, в какой момент кода возникает ошибка?   -  person gudal    schedule 17.06.2015
comment
Что вы пытаетесь сделать со строками Stop_Node = ActiveSheet.Range(B2:B73).Value и Conduit = ActiveSheet.Range(C2:C73).Value   -  person gudal    schedule 17.06.2015
comment
@gudal В указанном коде я получаю сообщение об ошибке, когда дохожу до оператора if. Что касается Stop_Node и Conduit, то копирую общий список люков и соответствующих труб (сливов к ним) в сети. Цель состоит в том, чтобы найти соответствующие каналы запрашиваемого люка. Спасибо   -  person İmtiaz    schedule 17.06.2015
comment
В порядке. На самом деле это можно сделать без VBA, но когда вы говорите автоматизировать, хотите ли вы, чтобы он делал это для всех люков, а затем что-то делал/использовал в другом фрагменте кода, или вы собираетесь просто выбрать люк из раскрывающегося списка? посмотреть соответствующие?   -  person gudal    schedule 18.06.2015
comment
@gudal, да, я хочу сделать это для всех люков, а затем сделать что-то с ним или использовать его в другом фрагменте кода. По сути, задача состоит в том, чтобы перемаркировать все узлы в сети в соответствии с определенным соглашением по маркировке. Этот код является частью более крупного кода для сопоставления всех люков в U/потоке с нисходящим/потоковым порядком.   -  person İmtiaz    schedule 18.06.2015

Ответы (2)


arrow_upward
1
arrow_downward

На самом деле, вы никогда не ReDim свой Result() так что это просто пустой массив без фактической ячейки (даже не пустая ячейка), вам сначала нужно ReDim его.

Вот моя версия, я не использовал функцию Match, но она все равно должна работать:

Function Conduitt(ManHole As String) As String()

Dim Stop_Node As Variant '/* All Manhole label */
Dim Conduit As Variant '/* All conduit label */
Dim Result() As String

ReDim Result(0)

Stop_Node = ActiveSheet.Range("B2:B73").Value
Conduit = ActiveSheet.Range("C2:C73").Value

For i = LBound(Stop_Node) To UBound(Stop_Node)
    If Stop_Node(i,1) <> ManHole Then
    Else
        Result(UBound(Result)) = Stop_Node(i,1)
        ReDim Preserve Result(UBound(Result) + 1)
    End If
Next i
ReDim Preserve Result(UBound(Result) - 1)

Conduitt = Result()

End Function
person R3uK    schedule 17.06.2015
comment
Ценю быстрый ответ R3uK - person İmtiaz; 17.06.2015
comment
@İmtiaz: Нет проблем, это решило вашу проблему? Если да, пожалуйста, подтвердите ответ (отметьте галочкой ниже голосование «за» или «против»), чтобы отметить вопрос как решенный! - person R3uK; 17.06.2015
comment
Ценю быстрый ответ R3uK. Я пытаюсь получить метку трубопровода, сравнивая метку Stop_Node с люком. Поэтому я немного изменил предложенный вами код, и он выглядит следующим образом: For i = LBound(Stop_Node) To UBound(Stop_Node) If Stop_Node(i) ‹› Manhole Then Else Result(UBound(Result)) = Conduit(i) ReDim Result( UBound(Result) + 1) End If Next i ReDim Result(UBound(Result) - 1) Conduitt = Result() End Function. Тем не менее, я все еще получаю ту же ошибку, как только достигаю «Еще». С уважением. - person İmtiaz; 17.06.2015
comment
Может быть, попробовать Dim Result() вместо Dim Result() As String, и если этого недостаточно, выделяется ли строка с Else при входе в режим отладки? Или это следующий? - person R3uK; 17.06.2015
comment
с Dim Result() я получаю «Ошибка компиляции: невозможно назначить массиву», а «Conduitt =» выделен (синим цветом) в строке, Conduitt = Result() ı.e. строка перед End Function. Затем, если я нажму OK, стрелка отладки вернется к строке Function Conduitt....... Может быть, это потому, что вывод функции определяется как строка в строке функции? Я предполагаю, что он выходит до достижения строки Else. В любом случае спасибо. Я продолжу искать. - person İmtiaz; 17.06.2015
comment
Вы установили точки останова, чтобы увидеть, как это происходит? (щелкните в серой области слева от кода и нажмите F5, чтобы продолжить). Я думаю, что последняя строка должна быть: Conduitt = Result, попробуйте - person R3uK; 17.06.2015

arrow_upward
1
arrow_downward

Что ж, видите, вы решили это, но вот альтернативное решение (пришлось опубликовать его сейчас, когда я над ним работал)

Function ConduittCheck(manhole As String) As String()
Dim result() As String

Dim manholeRange As Range
Dim conduittRange As Range
Set manholeRange = Range("manholes")
Set conduittRange = Range("conduitts")

Dim counter As Integer
Dim size As Integer
size = 0

For counter = 0 To manholeRange.Rows.Count
    If manholeRange.Rows.Cells(counter, 1) = manhole Then
        ReDim Preserve result(size)
        result(size) = conduittRange.Rows.Cells(counter, 1)
        size = size + 1
    End If
Next counter
ConduittCheck = result()
End Function
person gudal    schedule 18.06.2015
comment
Спасибо Гудал! Благодарим за помощь и новый подход к решению проблемы. - person İmtiaz; 19.06.2015
comment
@imtiaz: здесь ничего нового, та же структура, просто работа с диапазоном вместо массивов (что будет гораздо менее эффективно, поскольку массивы являются одним из ключей к эффективности VBA), size и counter - бесполезные переменные и, кроме того, counter начинаются с 0 выдаст ошибку на следующей строке... - person R3uK; 20.06.2015