如何开发对单单元格换行内容批量执行VLOOKUP的VBA函数

前置操作：插入VBA模块 #

• 打开目标Excel文件，按Alt + F11唤出VBA编辑器
• 在左侧项目资源管理器中右键点击当前工作簿名称，选择「插入」→「模块」

自定义函数代码 #

将以下代码粘贴到新建的模块中：

Function LookupNewlineSeparatedItems(lookupRange As Range, cell As Range) As String
    ' 变量声明
    Dim inputArr As Variant
    Dim resultArr As Variant
    Dim i As Long
    Dim matchResult As Variant
    ' 可自定义匹配失败时的返回值
    Const NOT_FOUND_FLAG As String = "N/A"
    
    ' 按换行符拆分待处理单元格内容为数组
    inputArr = Split(cell.Value, vbLf)
    ReDim resultArr(LBound(inputArr) To UBound(inputArr))
    
    ' 遍历执行匹配
    For i = LBound(inputArr) To UBound(inputArr)
        ' 执行精确匹配的VLOOKUP，Trim用于过滤待匹配值首尾多余空格
        matchResult = Application.VLookup(Trim(inputArr(i)), lookupRange, 2, False)
        ' 处理匹配失败的情况
        If IsError(matchResult) Then
            resultArr(i) = NOT_FOUND_FLAG
        Else
            resultArr(i) = matchResult
        End If
    Next i
    
    ' 拼接结果为换行分隔的字符串返回
    LookupNewlineSeparatedItems = Join(resultArr, vbLf)
End Function

注：原需求原型中的Cell参数类型为笔误，VBA中统一使用Range类型表示单元格对象，代码已做修正。

函数使用方法 #

• 回到Excel表格界面，选中需要输出结果的单元格
• 输入公式：=LookupNewlineSeparatedItems(查找区域, 待处理单元格)
• 示例：如果查找参考区域为D1:E4（第一列为索引列，第二列为结果列），待处理内容在A1单元格，公式为=LookupNewlineSeparatedItems(D1:E4, A1)
• 选中输出单元格，按Ctrl+1打开单元格格式设置，在「对齐」选项卡中勾选自动换行，即可正常显示多行结果

可调整配置 #

• 若需要修改匹配失败的返回值，直接修改代码中NOT_FOUND_FLAG的赋值即可，比如改成"未匹配"
• 不需要处理待匹配值首尾空格的话，删除代码中Trim()函数调用即可

内容的提问来源于stack exchange，提问作者Aleph0