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

如果您比较我之前提供的数据样本，对于人孔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

Answer 1

事实上，你永远不会ReDim你的Result()所以它只是一个没有实际单元格的空数组（甚至不是空单元格），你首先需要ReDim它。 / p>

这是我的版本，我没有使用函数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

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

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

多个vlookup的Excel VBA代码

2 个答案: