VBS正则练习题——标记并提取成对括号内的数值求和

killq

月关 发表于 2019-11-14 13:06
突然想起来，贴主要求加密。
不是老师不想传授，看来没有点小手段你还得再煎熬两天

duquancai

我没话说，路过凑热闹。

月关

killq 发表于 2019-11-14 18:03

要不把密码偷偷发你先提前学习下？
好好膜拜一下老师这个解题的思路，同时，在吃透老师解法的前提下，把问2的正则表达式再精简一下，有一串废代码。老审核，老师就懒得改了  

用心修炼

过来学习一下大佬们的思路

ggmmlol

月关 发表于 2019-11-14 11:02
老师不须担心，就冲他说的最后两句话，特殊字符和结果干净，就知道他连第1问都没解好。我都想不出来要怎 ...

我一点也不担心。因为这两问只不是饭前甜点和凉菜，真正的硬菜还没有上桌呢！就好比网游打副本，才开出来入门难度和普通难度，隐藏BOSS还没有出来呢！

ggmmlol

duquancai 发表于 2019-11-14 18:12
我没话说，路过凑热闹。

别介，你这正则高高高高高高高高手，都不说话，那岂不是把别人都吓住了

ggmmlol

duquancai 发表于 2019-11-14 18:12
我没话说，路过凑热闹。

还有，正式竞赛版块有一个VBA竞赛题正在进行中，用的实例来源正是你之前在我的主题贴子秀的一塌糊涂的替换字符的问题，想必这个竞赛题的3分技术分，对你这正则高手大侠来说，那是手到擒来的了。
我这赶紧给你建个传送门，别让大高手埋怨没有通知到而让你错过这机会呀：

[第127期]替换特定规则范围内的字符(进行中……)
http://club.excelhome.net/thread-1506418-1-1.html
(出处: ExcelHome技术论坛)

ggmmlol

月关 发表于 2019-11-14 18:20
要不把密码偷偷发你先提前学习下？
好好膜拜一下老师这个解题的思路，同时，在吃透老师解法的前提下，把 ...

本主题已满3天，请把密码公布，就像24楼所希望的那样，让大家学习一下你的思路吧。先给你点赞了！

killq

只写正则：
\d+(?:\.\d+)?(?=\s)
[\u4e00-\u9fa5]+(\d+(?:\.\d+)?)(?!$|[日月\d\.\s]) 取submatches
反正就是取巧，嘿嘿
放到程序里还可以使用chr(10)，不过需要字符连接

ggmmlol

当前2问，看来只要正则的基础知识扎实，就能正确解答。
我把自己对这2问的完整解答也放上来吧。

1. Option Explicit
   
2. Private Const 正则1$ = "小计\d*\.?\d+" '题1_填空处"
   
3. Private Const 正则2$ = "(?![月计])[一-龥]\d*\.?\d+" '题2_填空处
   
4. 
   
5. Sub Test1()
   
6.     Dim r&, ar, Reg As Object, br, ss$, mas As Object, ma As Object, v#, Start%, Length%, i&
   
7.     r = Cells(Rows.Count, 1).End(xlUp).Row
   
8.     With Range("A1").Resize(r)
   
9.         .Font.Bold = False
   
10.         .Font.Color = 0
    
11.         ar = .Resize(, 2).Value
    
12.     End With
    
13.     ReDim br(2 To r, 1 To 1)
    
14.     Set Reg = CreateObject("VBScript.RegExp")
    
15.     With Reg
    
16.         .Global = True
    
17.         .Pattern = 正则1
    
18.         For i = 2 To r
    
19.             ss = ar(i, 1) '题1_填空处2
    
20.             Set mas = .Execute(ss)
    
21.             For Each ma In mas
    
22.                 Start = ma.firstindex + 3 '题1_填空处3
    
23.                 Length = ma.Length - 2 '题1_填空处4
    
24.                 v = Mid(ma.Value, 3) '题1_填空处5
    
25.                 br(i, 1) = br(i, 1) + v
    
26.                 With Range("A" & i).Characters(Start, Length).Font
    
27.                     .Bold = True
    
28.                     .Color = vbBlue
    
29.                 End With
    
30.             Next
    
31.         Next
    
32.     End With
    
33.     Range("B2").Resize(r - 1) = br
    
34. End Sub
    
35. 
    
36. Sub Test2()
    
37.     Dim r&, ar, Reg As Object, br, ss$, mas As Object, ma As Object, v#, Start%, Length%, i&
    
38.     r = Cells(Rows.Count, 1).End(xlUp).Row
    
39.     With Range("A1").Resize(r)
    
40.         ar = .Resize(, 2).Value
    
41.     End With
    
42.     ReDim br(2 To r, 1 To 1)
    
43.     Set Reg = CreateObject("VBScript.RegExp")
    
44.     With Reg
    
45.         .Global = True
    
46.         .Pattern = 正则2
    
47.         For i = 2 To r
    
48.             ss = ar(i, 1) '题2_填空处2
    
49.             Set mas = .Execute(ss)
    
50.             For Each ma In mas
    
51.                 Start = ma.firstindex + 2 '题2_填空处3
    
52.                 Length = ma.Length - 1 '题2_填空处4
    
53.                 v = Mid(ma.Value, 2) '题2_填空处5
    
54.                 br(i, 1) = br(i, 1) + v
    
55.                 With Range("A" & i).Characters(Start, Length).Font
    
56.                     .Bold = True
    
57.                     .Color = vbRed
    
58.                 End With
    
59.             Next
    
60.         Next
    
61.     End With
    
62.     Range("C2").Resize(r - 1) = br
    
63. End Sub

复制代码