VBA之正则表达式（42）-- 快速提取名称-编程知识

VBA之正则表达式（42）-- 快速提取名称

实例需求：A列为待处理数据，现需要从中提取商品名、通用名、胰岛素笔相关信息，保存到B列至D列，需要注意如下几点：

胰岛素笔（E列）数据只存在于每组产品的第一行记录中，例如第2行数据中的“胰岛素笔”，对应第2~8行数据。
商品名称可能以数字或者字母结尾，通用名可能以数字开头

在这里插入图片描述

示例代码如下。

Sub Demo()Dim objRegExp As ObjectDim objMatch As ObjectDim arrRes(), strTxt, iRow, i, intLstRowDim rngRes As RangeSet objRegExp = CreateObject("vbscript.regexp")objRegExp.Pattern = "^([一-龟]{3}( [\d/]+| [A-Z\d]+){0,1}) (.*?)($| (/*[一-龟]{2,3}笔)+)"objRegExp.Global = TrueintLstRow = Cells(Rows.Count, 1).End(xlUp).RowReDim arrRes(1 To intLstRow - 1, 1 To 3)iRow = 1For i = 2 To intLstRowstrTxt = Trim(Cells(i, 1))Set objMatch = objRegExp.Execute(strTxt)If objMatch.Count > 0 ThenarrRes(iRow, 1) = objMatch(0).submatches(0)arrRes(iRow, 2) = objMatch(0).submatches(2)arrRes(iRow, 3) = Trim(objMatch(0).submatches(3))iRow = iRow + 1End IfNextWith Cells(2, 2).Resize(intLstRow - 1, 3).Clear.UnMerge.Value = arrResEnd WithSet rngRes = Cells(2, 4)For i = 3 To intLstRowIf Len(Trim(Cells(i, 4))) = 0 ThenSet rngRes = Union(rngRes, Cells(i, 4))ElseIf rngRes.Cells.Count > 1 Then rngRes.MergeSet rngRes = Cells(i, 4)End IfNextWith Cells(2, 4).Resize(intLstRow - 1, 1).HorizontalAlignment = xlCenter.VerticalAlignment = xlCenterEnd WithSet objRegExp = NothingSet objMatch = Nothing
End Sub

【代码解析】
第6行代码创建正则对象。
第7行代码设置正则匹配模式。

正则表达式	说明
`^([一-龟]{3}( [\d/]+\| [A-Z\d]+){0,1})`	匹配三个汉字字符开头，后面可以跟一个空格和数字/斜线或大写字母/数字的组合（可选）
`(.*?)`	匹配任意长度的任意字符，直到遇到下一个规则
`(/*[一-龟]{2,3}笔)+)`	匹配任意数量的斜线字符，之后跟两个或者三个汉字，最后以“笔”字结束

第8行代码设置正则全局匹配。
第12~21行代码循环处理每行数据。
第13行代码读取数据，并使用Trim函数去除空格。
第14第行代码执行正则匹配。
第15行代码判断匹配是否成功。
第16~18行代码读取匹配结果中的内容。
第23行代码清空保存结果的区域。
第23行代码取消合并单元格。
第24行代码将结果回写到单元格区域中。
第27~35行代码实现D列合并单元格。
第29行代码判断D列单元格是否空。