实例需求：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行代码设置正则匹配模式。

第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行代码释放对象变量占用的系统资源。