Excel 2010传递INDEX数组公式到VBA自定义函数报#VALUE!错误求解

错误根因 #

INDEX/VLOOKUP在数组公式中返回的是二维数组（列向匹配结果为n行1列的二维结构），你现有Merge函数中仅对输入做一次Transpose，无法将二维数组转换为Join函数支持的一维结构，因此触发#VALUE!报错。而MATCH返回的结果本身就是一维数组，所以可以正常运行。 #

方案1：修改Merge函数兼容所有数组输入 #

直接替换原有Merge函数代码，无需调整你之前写的数组公式，即可正常返回结果：

Public Function Merge(arr As Variant, Optional delimiter As String = ", ") As String
    Dim item As Variant, tmpArr() As String, i As Long
    ' 初始化临时数组，支持最多10000个元素拼接
    ReDim tmpArr(1 To 10000)
    i = 1
    ' 遍历所有元素不管数组维度
    For Each item In arr
        tmpArr(i) = CStr(item)
        i = i + 1
    Next
    ReDim Preserve tmpArr(1 To i - 1)
    Merge = Join(tmpArr, delimiter)
End Function

修改后你原来的INDEX数组公式直接按Ctrl+Shift+Enter输入即可得到正确的邮箱拼接字符串。 #

方案2：调整原有公式无需改代码 #

如果不想修改自定义函数，可在原有INDEX返回的结果外额外套一次TRANSPOSE，将二维数组转为一维后再传入Merge：

{=Merge(TRANSPOSE(INDEX(UserEmail,MATCH(TRIM(MID(SUBSTITUTE(D2,",",REPT(" ",199)),(ROW(OFFSET(D2,,,LEN(D2)-LEN(SUBSTITUTE(D2,",",""))+1))-(ROW(D2)))*199+((ROW(OFFSET(D2,,,LEN(D2)-LEN(SUBSTITUTE(D2,",",""))+1)))=(ROW(D2))),199)),UserName,0))))}

方案3：更简洁的全自定义函数方案 #

无需编写复杂数组公式，直接新增一个自定义函数，D5单元格仅需输入=GetEmails(D2, UserName, UserEmail)即可得到结果，适配性和运行效率更高：

Public Function GetEmails(inputStr As String, nameRng As Range, emailRng As Range, Optional delimiter As String = ", ") As String
    Dim nameArr As Variant, emailArr As Variant, emailMap As Object
    Dim i As Long, names As Variant, name As Variant, resArr() As String, cnt As Long
    
    ' 构建用户名-邮箱映射字典
    Set emailMap = CreateObject("Scripting.Dictionary")
    nameArr = nameRng.Value
    emailArr = emailRng.Value
    For i = 1 To UBound(nameArr, 1)
        emailMap(Trim(nameArr(i, 1))) = Trim(emailArr(i, 1))
    Next
    
    ' 拆分输入的用户名字符串匹配邮箱
    names = Split(inputStr, ",")
    ReDim resArr(1 To UBound(names) + 1)
    cnt = 0
    For Each name In names
        name = Trim(name)
        If emailMap.Exists(name) Then
            cnt = cnt + 1
            resArr(cnt) = emailMap(name)
        End If
    Next
    
    If cnt > 0 Then
        ReDim Preserve resArr(1 To cnt)
        GetEmails = Join(resArr, delimiter)
    Else
        GetEmails = ""
    End If
End Function

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