实例需求:根据第一列专业名称,在“专业分类指导目录”中,针对三个学历层次(研究生、本科生、专科生)分别查找对应专业类别,填写在对应位置,即截图中的黄色区域。
需要注意如下两点:
- “专业分类指导目录”中分隔符不统一,例如下图中红框内的部分,前两个分隔符为半角逗号,后两个分隔符为全角逗号。
- 有些专业名称可能包含在另一个专业名称中,例如:“兽医”是一个单独的专业,同时也出现在“基础兽医学”,“兽医医药”等专业中,在查找时需要精确匹配。
示例代码如下。
Sub Demo()With Sheet2arr = .Range(.[d4], .Cells(Rows.Count, 1).End(xlUp))End WithFor i = LBound(arr) To UBound(arr)For j = 2 To 4If arr(i, j) <> "" Then arr(i, j) = "," & Replace(Replace(arr(i, j), " ", ""), ",", ",") & ","NextNextSet rngData = Sheet4.[a1].CurrentRegionrngData.Offset(1, 1).ClearContentsbrr = rngData.ValueFor r = 2 To UBound(brr)iCnt = 0major = "," & brr(r, 1) & ","For i = LBound(arr) To UBound(arr)For j = 2 To 4If InStr(1, arr(i, j), major) > 0 Thenbrr(r, j) = arr(i, 1)iCnt = iCnt + 1If iCnt = 3 Then Exit ForEnd IfNextIf iCnt = 3 Then Exit ForNextNextrngData.Value = brr
End Sub
【代码解析】
第3行代码需将数据表格“专业分类指导目录”加载到数组中。
第5~9行代码循环遍历每行数据。
第6~8行代码循环每行中的数据。
第7行代码将时两个Replace
函数,清除专业清单中的空格,并将全角逗号替换为半角逗号,并且在字符串的首位附加一个半角逗号,这样可以更容易的实现精确匹配。
第10~13行代码需将需要填写的数据表格加载到数组中。
第11行代码清空需要填写的区域(截图中黄色区域)。
第13~26行代码循环遍历每行数据。
第15行代码构建查找关键字,此处同样在专业名称字符串的首位附加一个半角逗号。
精确匹配的实现原理如下,例如需要查找“兽医”专业,那么实际查找关键字为,兽医,
,在下面两个字符串中,仅能匹配第一个,而不会出现错误匹配。
- ,基础兽医学,兽医,临床兽医学,
- ,基础兽医学,预防兽医学,临床兽医学,
第16~25行代码双层循环在“专业分类指导目录”中查找关键字。
第19行代码提取对应的专业列表
第27行代码将查找结果更新到工作表中。