VBA之正则表达式（15）-- 提取数字求和

实例需求：提取

@

之间的纯数字(无小数点)，并将结果累计求和。

测试字符串：abc100@200@300$def400ghj@500@600

这个字符提取规则相对简单，直接使用VBA方法也可以实现。

Sub VBA_DEMO()
    Dim strTxt As String
    Dim arrData
    Dim strData As String
    Dim i As Integer
    Dim intAmt As Integer
    strTxt = "[email protected]@[email protected]@600"
    arrData = Split(strTxt, "@")
    For i = 1 To UBound(arrData) - 1
        strData = arrData(i)
        If IsNumeric(strData) Then intAmt = intAmt + Val(strData)
    Next i
    Debug.Print intAmt
End Sub
           

【代码解析】

第8行代码使用

SPLIT

函数以

@

作为分隔符将字符串拆分数组，注意数组的下标是从1开始的。

第11行代码使用

ISNUMRIC

函数判断数组元素是否只有数字，如果符合条件则进行累加。其中

VAL

函数将字符转换为数字，由于VBA中可以自动进行类型转换，所以此代码也可以简化为。

If IsNumeric(strData) Then intAmt = intAmt + strData
           

第13行代码在VBE的【立即】窗口中输出结果。

如果使用正则，该如何实现呢？

Sub RegExpDemo_0606()
    Dim strTxt As String, strKey As String
    Dim objRegEx As Object, objMatch As Object
    Dim objMH As Object
    Dim intAmt As Integer
    Set objRegEx = CreateObject("vbscript.regexp")
    objRegEx.Pattern = "@(\d+)@"
    objRegEx.Global = True
    strTxt = "[email protected]@[email protected]@600"
    Set objMatch = objRegEx.Execute(strTxt)
    If objMatch.Count > 0 Then
        For Each objMH In objMatch
            strKey = objMH.submatches(0)
            intAmt = intAmt + Val(strKey)
        Next
    End If
    Debug.Print intAmt
    Set objMH = Nothing
    Set objMatch = Nothing
    Set objRegEx = Nothing
End Sub
           

【代码解析】

第7行代码设置正则匹配模式为

@(\d+)@

，匹配组为一个或者多个数字，并且被

@

包裹。

如果匹配成功，第12到第15行使用

FOR

循环结构实现累加。

如果使用正则匹配不需要提取的字符，那么利用正则替换可以构造Excel公式来快速计算。

Sub RegExpDemo_REPLACE_0606()
    Dim strTxt As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("vbscript.regexp")
    objRegEx.Pattern = "^[^@]+?@|@(.*?[\D]+.*?)@|@[^@]+?$"
    objRegEx.Global = True
    strTxt = "[email protected]@[email protected]@600"
    Set objMatch = objRegEx.Execute(strTxt)
    If objRegEx.test(strTxt) Then
        Debug.Print Application.Evaluate(objRegEx.Replace(strTxt, "+") & "0")
    End If
    Set objRegEx = Nothing
End Sub
           

【代码解析】

第7行代码设置正则匹配模式为

^[^@]+?@|@(.*?[\D]+.*?)@|@[^@]+?$

，这个正则看着有些长，其实并不复杂。

正则表达式	说明
^[^@]+?@	匹配字符串开始位置到第一个 @ 之间至少包含一个非 @ 字符
@(.*?[\D]+.*?)@	匹配两个 @ 之间至少包含一个非 @ 字符，其前后可以有任意字符
@[^@]+?$	匹配字符串最后一个 @ 到结束位置之间至少包含一个非 @ 字符

第10行代码使用正则替换，将匹配字符替换为加号，并在尾部添加

构建公式，然后使用

EVALUATE

函数计算求和结果。

注意：

EVALUATE

函数可以计算如下第一个公式，也就是第一个字符为加号或者减号，此处会解析为正号或者负号。但是，

EVALUATE

函数无法解析第二个公式，并将产生运行时错误。

Application.Evaluate("+1+2")
Application.Evaluate("+1+2+")
           

使用正则几乎离不开JAVASCRIPT，一起看看JS如何实现。

Sub RegExpDemo_JS_0606()
    Dim objJS As Object
    Dim strTxt As String
    Set objJS = CreateObject("ScriptControl")
    objJS.Language = "javascript"
    strTxt = "[email protected]@[email protected]@600"
    objJS.AddCode ("var r=/@(\d+)@/g;" & _
                    "var s='" & strTxt & "'")
    Debug.Print objJS.eval("a=0;while(m=r.exec(s))a+=m[1]*1")
    Set objJS = Nothing
End Sub
           

【代码解析】

代码行数更少一些。

第7行和第8行代码添加JS代码，其中

r

为正则模式。

第9行代码使用

EVAL

函数返回计算结果，其中

a

用于保存累计结果，

while

循环遍历匹配组，

a+=m[1]*1

实现数字累计，此处

*1

是必须的，其目的是实现匹配组数字的类型转换，如果使用

a+=m[1]

，那么将使用字符串连接方式，输出结果变为

0200500

。

相关博文链接：

VBA之正则表达式（12）-- 格式调整

VBA之正则表达式（13）-- 字符串变换

VBA之正则表达式（14）-- 提取指定位数的数字

VBA之正则表达式（15）-- 提取数字求和

VBA之正则表达式（16）-- 提取非重复值

VBA之正则表达式（17）-- 提取多组数据（去除末尾字符）