用于多个vlookup的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

---

事实上，您从未

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

功能条件（人孔作为字符串）作为字符串（）
尺寸停止节点作为变型“/*所有人孔标签*/
将导管尺寸标注为变型“/*所有导管标签*/
Dim Result（）作为字符串
重拨结果（0）
Stop_Node=ActiveSheet.Range（“B2:B73”）.值
导管=ActiveSheet.范围（“C2:C73”）.值
对于i=LBound（停止节点）到UBound（停止节点）
如果停止节点（i，1）检修孔，则
其他的
结果（UBound（Result））=停止节点（i，1）
重播保留结果（UBound（结果）+1）
如果结束
接下来我
重拨保留结果（UBound（结果）-1）
Conduitt=结果（）
端函数

好吧，看来你已经解决了，但这里有一个替代方案（我已经完成了，现在不得不发布）

---

既然您希望返回3行中的值，为什么要使用函数而不是子例程？@Raystafarian:因为您可以将数组作为结果，因此更容易为其使用函数。您知道在代码中的什么时候会发生错误吗？您打算如何处理行Stop_Node=ActiveSheet.Range（“B2:B73”）.Value和conduct=ActiveSheet.Range（“C2:C73”）。Value@gudal在声明的代码中，我在到达if语句时点击了错误消息。关于Stop_节点和导管，我正在复制网络中人孔和相应管道（排水至人孔和管道）的总列表。目的是找到查询人孔的相应导管。感谢您的快速回复R3uK@İmtiaz：没问题，它解决了您的问题吗？如果是，请验证答案（在“向上/向下投票”下方打勾），将问题标记为已解决！感谢您的快速响应。我试图通过比较Stop_节点标签和人孔来获得导管标签。因此，我稍微修改了您建议的代码，如下所示：对于I=LBound（Stop_节点）到UBound（Stop_节点），如果Stop_节点（I）人孔，则为Else Result（UBound（Result））=conduct（I）ReDim Result（UBound（Result）+1）如果下一个I ReDim Result（UBound（Result）-1），则为End=Result（）结束函数。然而，一旦我到达“Else”，我仍然会遇到同样的错误。注意。请尝试

Dim Result（）

而不是将

Dim Result（）作为字符串

，如果不够，在进入调试模式后，是否突出显示带有

Else

的行？或者它是下一个吗？对于Dim Result（），我得到了“编译错误：无法分配给数组”，并且“conduit=”在第行中高亮显示（蓝色），conduit=Result（）ı.e。结束函数之前的行。然后，如果单击“确定”，调试箭头将移回Function Conduit……行。可能是因为函数输出在函数行中定义为字符串？我假设它在到达Else线之前退出。谢谢你。我会继续找的。谢谢古达尔！感谢您的帮助和解决此问题的新方法。@imtiaz：这里没有什么真正的新方法，相同的结构，只是使用范围而不是数组（这将大大降低效率，因为数组是VBA效率的关键之一），

大小

和

计数器

是无用的变量，而且

计数器

从0开始将在下一行生成错误。。。

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

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