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

ykqrs

ggmmlol 发表于 2019-12-12 21:27

今天才拜读这个帖子。
试着玩了一些其他条件的，
比如：
字符串："1a20s3ewww5(7e82d9gg5k)3c5h6u(9z)"
要求一次提取括号内单个数字紧跟单个非数字
7e-5k-9z
写了好几个，都经不起测试，老师有时间写一个，谢谢！

ggmmlol

ykqrs 发表于 2021-2-3 10:47
今天才拜读这个帖子。
试着玩了一些其他条件的，
比如：

这个练习题，只为了练习VBScript.Regexp引擎对于“逆序零宽断言”问题的处理方法，为了简化问题而突出方法，例子中的括号都是规定为全角括号的。你把字符串的括号改成如下全角形式的，再测试看看：
1a20s3ewww5（7e82d9gg5k）3c5h6u（9z）

ykqrs

ggmmlol 发表于 2021-2-3 11:12
这个练习题，只为了练习VBScript.Regexp引擎对于“逆序零宽断言”问题的处理方法，为了简化问题而突出方 ...

大师您好，以下代码可否简化？

1. Sub qq()
   
2. Dim str$, re As Object, mh As Object, s
   
3. str = "（1ha2s）3ewww5（7e82d9gg5k）3c5h6u（9z）"
   
4. '取出括号内单数字+非数字组合，比如3y,9他。。。。。
   
5. MsgBox str
   
6. Set re = CreateObject("VBSCRIPT.REGEXP")
   
7. re.Global = True
   
8. re.Pattern = "(?:\d{2,}\D|\d[^\d）]{2,}|(?:）|^)[^（]*|[\d\D]*?)*(\d((?![\d）]).)(?=[^（）]*）)|$)"
   
9. Set mh = re.Execute(str)
   
10. s = re.Replace(str, "$1-")
    
11. MsgBox s
    
12. End Sub

复制代码

ggmmlol

ykqrs 发表于 2021-2-3 10:47
今天才拜读这个帖子。
试着玩了一些其他条件的，
比如：

明白你所说的“单个数字紧跟单个非数字”了，它是以下表达式所匹配的第一个捕获分组的内容：
\D(\d\D)(?!\d)
结合另一个条件"在直接配对的括号内"，正则表达式的最终结果如下：

(?:(?:\)|^)[^\(]*|[\d\D]*?)*(?:\D(\d\D)(?=(\d[^\(]*)?\))|$)

编写过程如下：

1. Sub 取直接配对括号内的单个数字接单个非数字()
   
2.     s$ = "1a20s3ewww5(7e82d9gg5k)3c5h6u(9z)"
   
3.     pttn$ = "(?:eXp1|[\d\D]*?)*(?:eXp0|$)" '万能公式变体形式，其中，eXp0包含有对目标字符的捕获分组
   
4.    
   
5.     eXp0$ = "\D(\d\D)(?=(\d[^\(]*)?\))" '目标字符:右括号之前的单个数字紧接非数字
   
6.     eXp1$ = "(?:\)|^)[^\(]*" '必须显式排除的例外项:从右括号（或字符串开始位置）直到左括号之前的字符
   
7.    
   
8.     pttn = Replace(Replace(pttn, "eXp1", eXp1), "eXp0", eXp0) '代入万能公式
   
9.     Debug.Print pttn
   
10.    
    
11.     Set reg = CreateObject("VBScript.RegExp")
    
12.     reg.Global = True
    
13.     reg.Pattern = pttn
    
14.     s = reg.Replace(s, "$1-")
    
15.     s = Replace(s, "---", "")
    
16.     Debug.Print s
    
17. End Sub

复制代码

ggmmlol

ykqrs 发表于 2021-2-3 14:44
大师您好，以下代码可否简化？

re.Pattern = "(?:(?:）|^)[^（]*|[\d\D]*?)*(?:\D(\d\D)(?=(\d[^（]*)?）)|$)"

weiyingde

我做练习1'小计之后的数字之和。
Sub Test1()
    Dim r&, ar, Reg As Object, br, ss$, mas As Object, ma As Object, v#, Start%, Length%, i&
    r = Cells(Rows.Count, 1).End(xlUp).Row
    With Range("A1").Resize(r)
        .Font.Bold = False
        .Font.Color = 0
        ar = .Resize(, 2).Value
    End With
    ReDim br(2 To r, 1 To 1)
    Set Reg = CreateObject("VBScript.RegExp")
    With Reg
        .Global = True
        .Pattern = "小计\d+\.?\d*"
        For i = 2 To r
            ss = ar(i, 1)
            Set mas = .Execute(ss)
            For Each ma In mas
                Start = ma.FirstIndex + 2
                Length = ma.Length - 2
                v = Val(Right(ma, Len(ma) - 2))
                br(i, 1) = br(i, 1) + v
                With Range("A" & i).Characters(Start, Length).Font
                    .Bold = True
                    .Color = vbBlue
                End With
            Next
        Next
    End With
    Range("B2").Resize(r - 1) = br
End Sub

weiyingde

ykqrs 发表于 2021-2-3 10:47
今天才拜读这个帖子。
试着玩了一些其他条件的，
比如：

Sub test1() '要求一次提取括号内单个数字紧跟单个非数字7e-5k-9z
Dim s$, ss, n&, fi&, j&, pttn$, tmp$
sr = "1a20s3ewww5(7e82d9gg5k)3c5h6u(9z)"
With CreateObject("vbscript.regexp")
     .Pattern = "\(([^\(\)]+)\)"
     .Global = True
     
  Set mh = .Execute(sr)
      For Each mt In mh
        .Pattern = "(?:\D)\d\D(?=\d|\))"
        Set mhh = .Execute(mt)
          For Each mtt In mhh
             ssrr = Right(mtt, Len(mtt) - 1)
             asr = asr & "-" & ssrr
          Next
      Next
      asr = IIf(Left(asr, 1) = "-", Right(asr, Len(asr) - 1), asr)
      MsgBox asr
End With
End Sub