实例需求:订单数据保存在C列中,需要拆分菜品,每个菜品有三个字段:名称、单价、数量。拆分菜品后的单元格区域添加边框。如下图所示。
示例代码如下。
Sub Demo()
Dim arrRes()
Dim rngRes as Range
Dim objRegExp As Object
Dim objMatch As Object
Dim objSubMatchs as Object
Dim intMax As Integer
Dim lngLst as Long
Dim i, j, k
Set objRegExp = CreateObject("vbscript.regexp")
objRegExp.Pattern = "([一-龟【]+\d+.*?),单价(\d+)\*数量(\d+)"
objRegExp.Global = True
lngLst = Cells(Rows.Count, "C").End(xlUp).Row
ReDim arrRes(1 To lngLst - 5, 1 To 30)
For i = 6 To lngLst
strTxt = Cells(i, "C")
Set objMatch = objRegExp.Execute(strTxt)
If objMatch.Count > 0 Then
For j = 0 To objMatch.Count - 1
Set objSubMatchs = objMatch(j).submatches
For k = 1 To objSubMatchs.Count
arrRes(i - 5, j * 3 + k) = objSubMatchs(k - 1)
If k > intMax Then intMax = k
Next k
Next j
End If
Next i
Range("F6").CurrentRegion.Offset(2, 0).Clear
Set rngRes = Range("F6").Resize(lngLst - 5, 3 * intMax)
rngRes.Value = arrRes()
rngRes.Borders.LineStyle = xlContinuous
set objSubMatchs = Nothing
Set objRegExp = Nothing
Set objMatch = Nothing
End Sub
【代码解析】
第10行代码创建正则对象。
第11行代码设置匹配规则
正则表达式 | 说明 | 匹配字符 |
---|---|---|
([一-龟【]+\d+.*?) | 匹配中文字符或者全角左方括号,至少一个字符,之后为一个或者多个数字,最后任意字符(可以不存在) | 套餐4(螺蛳粉,配菜,饮料) |
单价(\d+) | 匹配关键字单价 ,之后为一个或者多个数字 | 单价20 |
数量(\d+) | 匹配关键字数量 ,之后为一个或者多个数字 | 数量1 |
第12行代码设置全局匹配。
第13行代码查找C列最后单元格的行号。
第14行代码重新声明数组保存拆分后的数据。
第15~27行代码循环处理订单数据。
第16行代码读取C列单元格内容。
第17行代码执行正则查找。
第18行代码判断是否正则匹配成功。
第19~25行代码循环遍历匹配结果。
第20行代码获取匹配组对象集合
第22行代码将匹配组保存在数据组中。
第23行代码iMax获取每个订单中最多产品数量。
第28行代码清空目标区域。
第29行代码获取写入数据的单元格区域。
第30行代码将数组中的数据写入单元格。
第31行代码设置单元格区域边框线。
第32~34行代码释放对象变量占用的系统资源。