今天记录一个关于字符串拆分的案例

需求

将一个单元格中多行字符串，按内容拆分成多行多列！

先来看看源数据，总共3列，区域代码、项目代码和投保标的物信息，投保标的物信息中每一行都用空行间隔。
任一行字符串，又分为4段，第1段是标的物，第2段是数量，第3段是单位，第4段是总投保金额。我们需要提取每一段中，“：”后与空格前这之间的内容。
最后的输出结果是这样的，区域代码、项目代码、标的物、数量、单位和总投保金额。一个标的物一行，项目有多个标的物，就输出多行。

尝试使用 VBA 和 Power Query 两种解决方法。

VBA

打开Visual Basic，插入模块，写一个sub过程。

装入源数据

先将源数据装入数组；接着，再定义一个结果数据brr，最后的结果有多少行，暂时不知道，一维定义要足够大，这里给到 1 To 2000，结果有6列，二维定义 1 To 6。

 Sub 提取字符串()
   '装入源数组
    Dim arr: arr = Sheets("数据源").Range("A1").CurrentRegion
    '定义结果数组
    Dim brr(1 To 2000, 1 To 6)
 End Sub

声明正则对象

处理字符串谁最强，当然是正则对象啦！
声明并赋值正则对象，接着设置正则对象的Global属性为 True，匹配出所有的符合正则表达式的结果，如果是False只匹配第一个就会停止。
Pattern属性，写上”=(:)(.?)(\s)”。其中的 . 表示0到多个的任意字符； ? 表示非贪婪匹配，尝试匹配尽可能少的字符； \s 表示是不可见字符； () 总是打成一个组。这段字符的意思是以 : 开头，以空格结尾的中间0到多个的任意字符，结果分成为3组。

    '声明正则对象
    Dim regx As Object, ms, m
    Set regx = CreateObject("Vbscript.Regexp")
    With regx
        '正则对象参数设置
        .Global = True                                  'true 搜索全部，false 搜索到的第一
        .Pattern = "(\:)(.*?)(\s)"                      '正则表达式，字符串
    End With

遍历源数组

下面就是主要代码了。先遍历源数组，源数据的第1行是表头，不需要处理，所以从第2行开始遍历。
要处理的是源数据的第3列，定义一个变量并赋值。

I    '遍历源数组
    Dim t As String, trr
    For i = 2 To UBound(arr)
        t = arr(i, 3)                                          '要处理的内容
    Next i

拆分字符串

细心的朋友可能发现了要处理的字符串中间都有空白行，所以先用换行符来拆分单元格中的内容，拆分成每一行，方便后面处理。拆分字符串必须使用Split函数，分隔符用换行符（vbLf），使用变量trr接收拆分后的结果数组。

        '拆分字符串
        trr = Split(t, vbLf)                         

应用正则

接着，对拆分后数组trr的元素进行逐一处理。依然还是遍历，遍历trr，先用正则对象的 Test 方法，测试能否匹配的到，如果匹配的到，返回 True，就进行累加计数，看看有多少行；brr的第1列，写入区域代码，第2列写入项目代码。
接着用正则对象的Execute方法，对trr数组元素应用正则表达式，返回一个Match集合对象，用For Each遍历Match集合。

      '遍历要处理的字符串数组
        For j = 0 To UBound(trr)
            If regx.Test(trr(j)) Then              'test,正则表达式匹配结果，一个布尔值
                k = k + 1                          '行计数
                brr(k, 1) = arr(i, 1)              '写入区域
                brr(k, 2) = arr(i, 2)              '写入项目代码
                Set ms = regx.Execute(trr(j))      '对字符串应用正则，返回一个Match集合
                '提取结果
                For Each m In ms                   '遍历match集合
                    stop
                Next
            End If
        Next j      

提取结果

这里打个断点，打开立即窗口查看一下，发现每个Match下会有3个SubMatches对象，分别对应正则表达式的3个分组，下标是从0开始，要取的是下标为1的结果。

需要将Match集合对应的标的物、单位、数量和总投保金额转置成列，所以这里增加一个累加计数，前面已经有2列，也就是区域代码和项目代码，所以累加从3开始，累加变量初始值设置为2，再加1，就是从3开始。每一次遍历时，都会重置为变量初始值。

      '遍历要处理的字符串数组
        For j = 0 To UBound(trr)
            If regx.Test(trr(j)) Then              'test,正则表达式匹配结果，一个布尔值
                k = k + 1                          '行计数
                brr(k, 1) = arr(i, 1)              '写入区域
                brr(k, 2) = arr(i, 2)              '写入项目代码
                Set ms = regx.Execute(trr(j))      '对字符串应用正则，返回一个Match集合
                '提取结果
                 kk = 2
                For Each m In ms                               '遍历match集合
                    kk = kk + 1                                '列计数
                    brr(k, kk) = m.SubMatches(1)               '写入匹配的结果
                Next
            End If
        Next j      

写入结果

遍历结束，结果已经提取出来了，接下来就是把结果数组写入到结果表中。
写入前，先清空结果表的已使用区域，清除原有内容。
接着从结果表的A1单元格用Resize函数扩展1行6列，写入使用Array函数创建的表头数组；从结果表的A2单元格用Resize函数扩展2000行6列，写入结果数组brr。

'写入结果
    With Sheets("VBA方法")
        '清空已使用区域
        .UsedRange.Clear
        '写入表头
        .[A1].Resize(1, 6) = Array("区域代码", "项目代码", "标的物", "数量", "单位", "总投保金额")
        '写入结果
        .[A2].Resize(2000, 6) = brr
    End With

回到结果表中，看看结果是不是已经出来了。

代码优化

代码的功能已经实现了，还可以进一步优化，以提升运算速度，比如对正则对象和结果表使用with语句、代码结束后清空定义的对象释放内存、开始时关闭屏幕刷新，结束时记得一定要打开屏幕刷新。

 '清空对象,释放内存
    Set m = Nothing
    Set ms = Nothing
    Set regx = Nothing
 '打开屏幕刷新
    Application.ScreenUpdating = True                         

完整代码

Sub 提取字符串()
    '关闭屏幕刷新
    Application.ScreenUpdating = False
    '装入源数组
    Dim arr: arr = Sheets("数据源").Range("A1").CurrentRegion
    '定义结果数组
    Dim brr(1 To 2000, 1 To 6)
    '声明正则对象
    Dim regx As Object, ms, m
    Set regx = CreateObject("Vbscript.Regexp")
    With regx
        '正则对象参数设置
        .Global = True                                         'true 搜索全部，false 搜索到的第一
        .Pattern = "(\:)(.*?)(\s)"                             '正则表达式，字符串
    End With
    '遍历源数组
    Dim t As String, trr, k, kk
    For i = 2 To UBound(arr)
        t = arr(i, 3)                                          '要处理的内容
        trr = Split(t, vbLf)                                   '拆分要处理的单元格内容
        '遍历要处理的字符串数组
        For j = 0 To UBound(trr)
            If regx.Test(trr(j)) Then                          'test,正则表达式匹配结果，一个布尔值
                k = k + 1                                      '行计数
                brr(k, 1) = arr(i, 1)                          '写入区域
                brr(k, 2) = arr(i, 2)                          '写入项目代码
                Set ms = regx.Execute(trr(j))                  '对字符串应用正则，返回一个Match集合
                '提取结果
                kk = 2
                For Each m In ms                               '遍历match集合
                    kk = kk + 1                                '列计数
                    brr(k, kk) = m.SubMatches(1)               '写入匹配的结果
                Next
            End If
        Next j
    Next i
    '写入结果
    With Sheets("VBA方法")
        '清空已使用区域
        .UsedRange.Clear
        '写入表头
        .[A1].Resize(1, 6) = Array("区域代码", "项目代码", "标的物", "数量", "单位", "总投保金额")
        '写入结果
        .[A2].Resize(2000, 6) = brr
    End With
    '清空对象,释放内存
    Set m = Nothing
    Set ms = Nothing
    Set regx = Nothing
    '打开屏幕刷新
    Application.ScreenUpdating = True
End Sub

结束语

整体代码比较简单，主要是正则表达式的理解。正则表达式很强大，经常处理字符串的朋友值得好好研究下。
下一期，看看 Power Query 如何解决这个问题。