博客

实例需求：数据保存在A列中，数据组之间使用全角逗号分隔，重整后需要将每组数据开始的圆括号部分移动到末尾，并合并相同的全角方括号内容。貌似这个需求有些拗口，实际效果见B列。



示例代码如下。

Sub RegExpReOrg()
    Dim strTxt As String, strKey As String
    Dim objRegEx As Object, objMatch As Object
    Dim objMH As Object, c As Range, rngData As Range
    Dim dic As Object, k
    Set objRegEx = CreateObject("vbscript.regexp")
    Set dic = CreateObject("scripting.dictionary")
    objRegEx.Pattern = "(\(\d+\))(【.+?】)(.*?)，"
    objRegEx.Global = True
    Set rngData = Range([A2], Cells(Rows.Count, "A").End(xlUp))
    rngData.Offset(0, 1).ClearContents
    For Each c In rngData
        strTxt = Application.Clean(c.Value) & "，"
        Set objMatch = objRegEx.Execute(strTxt)
        If objMatch.Count > 0 Then
            dic.RemoveAll
            For Each objMH In objMatch
                strKey = objMH.submatches(1)
                If dic.exists(strKey) Then
                    dic(strKey) = dic(strKey) & "，" & objMH.submatches(2) & objMH.submatches(0)
                Else
                    dic(strKey) = objMH.submatches(2) & objMH.submatches(0)
                End If
            Next
            strTxt = ""
            For Each k In dic.Keys
                strTxt = strTxt & Chr(10) & k & dic(k)
            Next
            c.Offset(0, 1) = Mid(strTxt, 2)
        End If
    Next
    Set objMH = Nothing
    Set objMatch = Nothing
    Set objRegEx = Nothing
End Sub

【代码解析】

第6行代码使用后期绑定创建字典对象。

第7行代码使用后期绑定创建正则对象。

第8行代码指定正则匹配字符串。

第9行代码指定数据区域。

第10行代码清空B列单元格。

第12行代码第31行代码循环处理工作表A列中的数据。

第13行代码读取单元格内容并在末尾添加一个全角逗号，便于正则匹配

第14行代码执行正则匹配。

如果匹配成功，那么第17行到第24行代码使用For循环结构整理数据。

第16行代码清空字典。

第18行代码获取字典的键值。

第19行到第23行代码如果字典中存在相同键值，就将相应的字符组合后保存在字典中，如果不存在，则添加键值对。

第26行到第28行代码按照多行格式整理数据。

第29行代码将数据写入B列单元格。

相关博文链接：


VBA之正则表达式（1）– 基础篇



VBA之正则表达式（2）– 批量修改公式



VBA之正则表达式（3）– 特殊公式计算



VBA之正则表达式（4）– 提取日期和金额



VBA之正则表达式（5）– 中文字符



VBA之正则表达式（6）– 设置音标格式



VBA之正则表达式（7）– 乾坤大挪移（数据整理）



VBA之正则表达式（8）– 重复字符分组



VBA之正则表达式（9）– 添加千分位（1/3）



VBA之正则表达式（10）– 添加千分位（2/3）



VBA之正则表达式（11）– 添加千分位（3/3）