實(shí)例需求：提取@之間的純數(shù)字(無小數(shù)點(diǎn))，并將結(jié)果累計(jì)求和。
測試字符串：abc100@200@300$def400ghj@500@600
這個字符提取規(guī)則相對簡單，直接使用VBA方法也可以實(shí)現(xiàn)。
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 intAmtEnd Sub【代碼解析】
第8行代碼使用SPLIT函數(shù)以@作為分隔符將字符串拆分?jǐn)?shù)組，注意數(shù)組的下標(biāo)是從1開始的。
第11行代碼使用ISNUMRIC函數(shù)判斷數(shù)組元素是否只有數(shù)字，如果符合條件則進(jìn)行累加。其中VAL函數(shù)將字符轉(zhuǎn)換為數(shù)字，由于VBA中可以自動進(jìn)行類型轉(zhuǎn)換，所以此代碼也可以簡化為。
If IsNumeric(strData) Then intAmt = intAmt + strData第13行代碼在VBE的【立即】窗口中輸出結(jié)果。
如果使用正則，該如何實(shí)現(xiàn)呢？
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 = NothingEnd Sub【代碼解析】
第7行代碼設(shè)置正則匹配模式為@(\d+)@，匹配組為一個或者多個數(shù)字，并且被@包裹。
如果匹配成功，第12到第15行使用FOR循環(huán)結(jié)構(gòu)實(shí)現(xiàn)累加。
如果使用正則匹配不需要提取的字符，那么利用正則替換可以構(gòu)造Excel公式來快速計(jì)算。
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 = NothingEnd Sub【代碼解析】
第7行代碼設(shè)置正則匹配模式為^[^@]+?@|@(.*?[\D]+.*?)@|@[^@]+?$，這個正則看著有些長，其實(shí)并不復(fù)雜。
| 正則表達(dá)式 | 說明 |
|---|---|
^[^@]+?@ | 匹配字符串開始位置到第一個@之間至少包含一個非@字符 |
@(.*?[\D]+.*?)@ | 匹配兩個@之間至少包含一個非@字符，其前后可以有任意字符 |
@[^@]+?$ | 匹配字符串最后一個@到結(jié)束位置之間至少包含一個非@字符 |
第10行代碼使用正則替換，將匹配字符替換為加號，并在尾部添加0構(gòu)建公式，然后使用EVALUATE函數(shù)計(jì)算求和結(jié)果。
注意：EVALUATE函數(shù)可以計(jì)算如下第一個公式，也就是第一個字符為加號或者減號，此處會解析為正號或者負(fù)號。但是，EVALUATE函數(shù)無法解析第二個公式，并將產(chǎn)生運(yùn)行時錯誤。
Application.Evaluate("+1+2")Application.Evaluate("+1+2+")使用正則幾乎離不開JAVASCRIPT，一起看看JS如何實(shí)現(xiàn)。
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 = NothingEnd Sub【代碼解析】
代碼行數(shù)更少一些。
第7行和第8行代碼添加JS代碼，其中r為正則模式。
第9行代碼使用EVAL函數(shù)返回計(jì)算結(jié)果，其中a用于保存累計(jì)結(jié)果，while循環(huán)遍歷匹配組，a+=m[1]*1實(shí)現(xiàn)數(shù)字累計(jì)，此處*1是必須的，其目的是實(shí)現(xiàn)匹配組數(shù)字的類型轉(zhuǎn)換，如果使用a+=m[1]，那么將使用字符串連接方式，輸出結(jié)果變?yōu)?code>0200500。
