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 = "abc100@200@300$def400ghj@500@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 = "abc100@200@300$def400ghj@500@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 = "abc100@200@300$def400ghj@500@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行代码使用正则替换，将匹配字符替换为加号，并在尾部添加0构建公式，然后使用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 = "abc100@200@300$def400ghj@500@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）-- 提取多组数据（去除末尾字符）