将Excel的FILTER+TEXTJOIN公式转换为可复用VBA加载项

以下是完全替代你原有Excel公式的VBA自定义函数，可直接添加到加载项中复用，支持接收返回值范围、匹配数据范围和关键字作为参数：

Function MultiLookupCsv(rngReturn As Range, rngMatch As Range, lookupKey As Variant) As String
    Dim wsReturn As Worksheet, wsMatch As Worksheet
    Dim lastRowReturn As Long, lastRowMatch As Long
    Dim i As Long
    Dim resultArr As Collection
    
    ' 初始化结果集合
    Set resultArr = New Collection
    
    ' 检查参数有效性
    If rngReturn Is Nothing Or rngMatch Is Nothing Then
        MultiLookupCsv = "#参数错误"
        Exit Function
    End If
    
    ' 获取两个范围的工作表对象
    Set wsReturn = rngReturn.Parent
    Set wsMatch = rngMatch.Parent
    
    ' 获取两列的实际数据行数（避免整列遍历浪费资源）
    lastRowReturn = wsReturn.Cells(wsReturn.Rows.Count, rngReturn.Column).End(xlUp).Row
    lastRowMatch = wsMatch.Cells(wsMatch.Rows.Count, rngMatch.Column).End(xlUp).Row
    
    ' 确保两列数据行数一致，否则返回错误
    If lastRowReturn <> lastRowMatch Then
        MultiLookupCsv = "#范围行数不匹配"
        Exit Function
    End If
    
    ' 遍历匹配列，收集符合条件的返回值（忽略空值）
    For i = 1 To lastRowMatch
        ' 匹配关键字，同时跳过返回值为空的单元格
        If wsMatch.Cells(i, rngMatch.Column).Value = lookupKey And _
           Trim(wsReturn.Cells(i, rngReturn.Column).Value) <> "" Then
            resultArr.Add wsReturn.Cells(i, rngReturn.Column).Value
        End If
    Next i
    
    ' 将集合中的结果用逗号加空格拼接成字符串
    If resultArr.Count > 0 Then
        Dim tempArr() As String
        ReDim tempArr(1 To resultArr.Count)
        For i = 1 To resultArr.Count
            tempArr(i) = resultArr(i)
        Next i
        MultiLookupCsv = Join(tempArr, ", ")
    Else
        ' 无匹配结果时返回空字符串（和原公式逻辑一致）
        MultiLookupCsv = ""
    End If
    
    ' 清理对象
    Set resultArr = Nothing
    Set wsReturn = Nothing
    Set wsMatch = Nothing
End Function

代码说明 #

• 参数定义：rngReturn对应原公式的K列（返回值来源），rngMatch对应原公式的N列（匹配数据范围），lookupKey对应A2的匹配关键字
• 性能优化：只遍历两列的实际数据行，而非整列，避免无效计算
• 空值处理：自动忽略返回值为空的单元格，对应原公式TEXTJOIN的TRUE参数
• 错误防护：检查参数有效性、范围行数一致性，返回明确的错误提示

使用方法 #

1. 打开Excel，按Alt+F11打开VBA编辑器
2. 插入新模块：右键点击左侧工程窗口中的加载项文件（或新建模块）→ 插入 → 模块
3. 将上述代码粘贴到模块中，保存加载项为.xlam格式
4. 在Excel单元格中调用函数，格式和原公式一致：

   =MultiLookupCsv('[myFile.xlsx]ForLookUp'!$K:$K, '[myFile.xlsx]ForLookUp'!$N:$N, A2)
   

注意事项 #

• 如果匹配的工作簿未打开，需确保文件路径完整（比如="C:\Files\myFile.xlsx]ForLookUp'!$K:$K"）
• 关键字匹配为精确匹配，和原公式的=逻辑完全一致
• 支持跨工作表、跨工作簿调用，和原公式的使用场景完全兼容

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