VBA之正则表达式(40)-- 多组数据拆分

82 篇文章 6 订阅
51 篇文章 18 订阅

实例需求:订单数据保存在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行代码释放对象变量占用的系统资源。

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值