VBA之正则表达式（42）

#VBA之正则表达式（42）| 来源: 网络整理| 查看: 265

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

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

在这里插入图片描述

示例代码如下。

Sub Demo() Dim objRegExp As Object Dim objMatch As Object Dim arrRes(), strTxt, iRow, i, intLstRow Dim rngRes As Range Set objRegExp = CreateObject("vbscript.regexp") objRegExp.Pattern = "^([一-龟]{3}( [\d/]+| [A-Z\d]+){0,1}) (.*?)($| (/*[一-龟]{2,3}笔)+)" objRegExp.Global = True intLstRow = Cells(Rows.Count, 1).End(xlUp).Row ReDim arrRes(1 To intLstRow - 1, 1 To 3) iRow = 1 For i = 2 To intLstRow strTxt = Trim(Cells(i, 1)) Set objMatch = objRegExp.Execute(strTxt) If objMatch.Count > 0 Then arrRes(iRow, 1) = objMatch(0).submatches(0) arrRes(iRow, 2) = objMatch(0).submatches(2) arrRes(iRow, 3) = Trim(objMatch(0).submatches(3)) iRow = iRow + 1 End If Next With Cells(2, 2).Resize(intLstRow - 1, 3) .Clear .UnMerge .Value = arrRes End With Set rngRes = Cells(2, 4) For i = 3 To intLstRow If Len(Trim(Cells(i, 4))) = 0 Then Set rngRes = Union(rngRes, Cells(i, 4)) Else If rngRes.Cells.Count > 1 Then rngRes.Merge Set rngRes = Cells(i, 4) End If Next With Cells(2, 4).Resize(intLstRow - 1, 1) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Set objRegExp = Nothing Set 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列单元格是否空。

如果为空，则第30行代码将单元格区域合并至变量rngRes中。如果不为空，则第32行代码上一组产品对应D列合并，并初始化变量rngRes。

第36~39行代码设置D列格式水平居中垂直居中。第40~41行代码释放对象变量占用的系统资源。

【本文地址】

公司简介

联系我们