VBA函数用于从单个单元格中提取多个值并将它们索引/匹配到值

时间:2017-04-26 23:47:35

标签: vba indexing split match explode

我在使用用户定义的函数将单个单元格字符串分解为多个值时遇到问题,然后以索引/匹配方式匹配每个值,返回单个单元格,其中包含用逗号分隔的匹配值的字符串

示例:

Roles             Names           Role      Name
role1/role2       name1,name2     role1     name1
role1             name1           role2     name2
role2/role3       name2,name3     role3     name3
role1/role4       name1,name4     role4     name4
role3/role5       name3,name5     role5     name5

我想获得一个从Roles,Role和Name列生成“names”列的函数。

到目前为止,这是我的VBA代码:

Public Function RoleToName(role, roles_rng, names_rng) As String
    Dim result As String
    Dim s As Variant

    For Each s In Split(role, "/")
        ???
    Next s
End Function

感谢。

2 个答案:

答案 0 :(得分:2)

Public Function RoleToName(role, roles_rng, names_rng) As String
    Dim result As String
    Dim s As Variant, m, sep As String

    For Each s In Split(role, "/")
        'Trim each value in case of extra spaces...
        m = Application.Match(Trim(s), roles_rng, 0)
        If Not IsError(m) Then
            result = result & sep & names_rng.Cells(m).Value
        Else
            result = result & sep & "??" '<< role not found...
        End If
        sep = ","
    Next s
    RoleToName = result
End Function

答案 1 :(得分:0)

试一试,

Function udf_CollateNames(roles As String, tbl As Range, _
                          Optional roleSplit As String = "/", _
                          Optional delim As String = ",")
    Dim v As Long, vVALs As Variant

    vVALs = Split(roles, roleSplit)

    For v = LBound(vVALs) To UBound(vVALs)
        If Not IsError(Application.Match(Trim(vVALs(v)), tbl.Columns(1), 0)) Then _
            udf_CollateNames = udf_CollateNames & delim & Application.VLookup(Trim(vVALs(v)), tbl, 2, False)
    Next v

    udf_CollateNames = Mid(udf_CollateNames, Len(delim) + 1)
End Function

enter image description here