快速多列查找匹配关键字

实例需求：根据第一列专业名称，在“专业分类指导目录”中，针对三个学历层次（研究生、本科生、专科生）分别查找对应专业类别，填写在对应位置，即截图中的黄色区域。

在这里插入图片描述

需要注意如下两点：

“专业分类指导目录”中分隔符不统一，例如下图中红框内的部分，前两个分隔符为半角逗号，后两个分隔符为全角逗号。
有些专业名称可能包含在另一个专业名称中，例如：“兽医”是一个单独的专业，同时也出现在“基础兽医学”，“兽医医药”等专业中，在查找时需要精确匹配。

在这里插入图片描述

示例代码如下。

Sub Demo()
    With Sheet2
        arr = .Range(.[d4], .Cells(Rows.Count, 1).End(xlUp))
    End With
    For i = LBound(arr) To UBound(arr)
        For j = 2 To 4
            If arr(i, j) <> "" Then arr(i, j) = "," & Replace(Replace(arr(i, j), " ", ""), "，", ",") & ","
        Next
    Next
    Set rngData = Sheet4.[a1].CurrentRegion
    rngData.Offset(1, 1).ClearContents
    brr = rngData.Value
    For r = 2 To UBound(brr)
        iCnt = 0
        major = "," & brr(r, 1) & ","
        For i = LBound(arr) To UBound(arr)
            For j = 2 To 4
                If InStr(1, arr(i, j), major) > 0 Then
                    brr(r, j) = arr(i, 1)
                    iCnt = iCnt + 1
                    If iCnt = 3 Then Exit For
                End If
            Next
            If iCnt = 3 Then Exit For
        Next
    Next
    rngData.Value = brr
End Sub

【代码解析】
第3行代码需将数据表格“专业分类指导目录”加载到数组中。
第5~9行代码循环遍历每行数据。
第6~8行代码循环每行中的数据。
第7行代码将时两个Replace函数，清除专业清单中的空格，并将全角逗号替换为半角逗号，并且在字符串的首位附加一个半角逗号，这样可以更容易的实现精确匹配。
第10~13行代码需将需要填写的数据表格加载到数组中。
第11行代码清空需要填写的区域（截图中黄色区域）。
第13~26行代码循环遍历每行数据。
第15行代码构建查找关键字，此处同样在专业名称字符串的首位附加一个半角逗号。

精确匹配的实现原理如下，例如需要查找“兽医”专业，那么实际查找关键字为,兽医,，在下面两个字符串中，仅能匹配第一个，而不会出现错误匹配。