Excel VBA 多个 vlookup 的代码

Question

对于管道网络，我试图找到排入检修孔的管道。可以有多个管道可以排放到一个检修孔。我的数据结构按以下方式组织：

   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

如果你比较一下我之前提供的数据样本，对于Manhole MH-39，对应的导管标签是，CO-43，CO-45和CO-51。我想，countc 由于 do 循环而改变，它将遍历列表并找到 MH-39 和 return CO-43、CO-45 和 CO-51.

Objective 是为了 return 这些管道标签仅作为一个字符串数组 三行（对于 MH-39 的情况）。

到目前为止，当我运行代码时，我得到：

Run-time error '9': Subscript out of range.

我搜索了不同的论坛，发现当引用不存在的数组元素时会发生这种情况。至此，我有限的知识和经验无助于破解这个谜题。

根据的一些建议，修复了代码。显然，当将范围分配给变体数组时（如 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

Answer 1

事实上，你永远不会 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

Answer 2

好吧，看到你解决了它，但这里有一个替代解决方案（现在我必须 post 它已经开始工作了）

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

Excel VBA 多个 vlookup 的代码

Excel VBA code for multiple vlookup

excel

vba

vlookup