如何用VBA实现跨工作表无需传参的多查找结果合并到单个单元格

原代码逐单元格遍历查询区域，频繁与工作表交互是运行慢的核心原因，同时硬编码要求传参不符合无参调用需求。

本次优化核心逻辑：

• 将整个查询区域一次性读入内存数组，所有匹配判断在内存中完成，大幅降低IO开销，数据量越大提速效果越明显，普遍可提升10~100倍运行效率
• 内置固定参数配置段，只需首次调整参数，后续调用无需传参
• 天然支持跨工作表指定查询区域，无需额外适配

Function SingleCellExtract() As String
    ' ****************** 固定参数配置段 首次使用修改此处即可 ******************
    Const LOOKUP_VALUE As String = "你要固定的查询值" ' 固定查询值，若需要取当前单元格左侧值可替换为：LOOKUP_VALUE = Application.Caller.Offset(0, -1).Value
    Const LOOKUP_RANGE_ADDRESS As String = "Sheet2!A:A" ' 支持跨表指定查询范围，示例为Sheet2的A列
    Const COLUMN_NUMBER As Integer = 2 ' 返回匹配行的第N列值
    Const SEPARATOR As String = "," ' 结果分隔符
    ' **********************************************************************
    
    Dim lookupArr As Variant, resStr As String, i As Long
    Dim lookupRng As Range
    
    ' 初始化查询区域
    Set lookupRng = Range(LOOKUP_RANGE_ADDRESS)
    ' 区域值一次性读入数组，减少工作表交互
    lookupArr = lookupRng.Resize(, COLUMN_NUMBER).Value
    
    ' 内存中遍历匹配，效率远高于逐单元格读取
    For i = 1 To UBound(lookupArr, 1)
        If lookupArr(i, 1) = LOOKUP_VALUE Then
            If resStr = "" Then
                resStr = lookupArr(i, COLUMN_NUMBER)
            Else
                resStr = resStr & SEPARATOR & lookupArr(i, COLUMN_NUMBER)
            End If
        End If
    Next i
    
    SingleCellExtract = resStr
End Function

使用说明：

• 首次使用时修改代码开头固定参数配置段的4个常量，匹配自己的业务需求即可
• 单元格内直接输入=SingleCellExtract()就能返回结果，无需传入任何参数
• 如果需要查询不同工作表的区域，只需修改LOOKUP_RANGE_ADDRESS常量的地址即可

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