excel VBA正则提取字符（自定义函数）

正则提取字符自定义函数下载： RegExp.xls (40.5 KB, 下载次数: 79)

2017-7-6 13:52 上传

点击文件名下载附件

1. Function TQ(txt$, Optional k = 0, Optional pt = 1, Optional s$ = "")

复制代码

自定义函数说明：

第一参数【txt】：必须，为提取对象字符串或其单元格引用地址

第二参数【k】：提取模式、兼提取位置
  ①        默认k=0【零】时为Replace模式，按pattern进行replace置换      置换结果按第四参数s，该s参数默认="",即把正则匹配结果直接置换去掉。
                                          如果该参数=其它字符，那么置换结果为指定字符s内容
      但如果是特殊字符$1、$2……这样的，代表按正则提取的第n组结果内容进行置换

  ②-1
        k>0【正整数】时为Matches模式， 返回按pattern提取同类组后第k组的字符结果
  ②-2
       k>0 且含小数点[.]时，直接提取全部Matches结果，并转入数组a后 join合并输出。一般都输入k=1.1即可。


  ③-1
       k<0 【负整数】时为SubMatches模式，返回pattern提取后指定大组对应的小组的全部字符结果，并转入数组b后 join合并输出。
  ③-2        
       k<0且含小数点[.]时【负小数】时为SubMatches模式，返回按多组pattern提取后[整数部分]大组的[小数部分]小组的字符结果
      
       整数部分为：Int(-k) - 1)
      小数部分未：Mid(k, InStr(k, ".") + 1) - 1
    如k=-3.1 即为提取第3组的第1小组部分字符 → 3.1


第三参数【pt】：正则pattern，输入或默认常用pattern
该参数为1-7的有效数值时，使用默认预置的常用pattern效果如下：
参数pt        pattern                                 效果
=1      \w or [0-9a-zA-Z] or [a-zA-Z0-9]   匹配置换英数字符，保留返回文字字符。
=2      [^a-zA-Z]                                   匹配置换非英字符，保留返回英文字符。
=3      \D                                              匹配置换非数字符，保留返回数字字符。
=4      [^a-z]                                        匹配置换非小写英字，保留返回小写英字符。
=5      [^A-Z]                                       匹配置换非大写英字，保留返回大写英字符。
=6      \W or [^0-9a-zA-Z]                      匹配置换非英非数字，保留返回英数字符。
=7      \d                                              匹配置换数字字符，保留返回英字以及汉字字符。

增加了第四参数【s】： 置换时，可选择置换结果，默认="" 即直接置换掉。
也可以置换为自己需要的内容，
或者进行组置换如 "$1" 或 "$2"等

1. 
   
2. Function TQ(txt$, Optional k = 0, Optional pt = 1, Optional s$ = "")
   
3. 
   
4.     If IsNumeric(pt) Then pt = Choose(pt, "\w", "[^a-zA-Z]", "\D", "[^a-z]", "[^A-Z]", "\W", "\d")
   
5.     With CreateObject("VBScript.RegExp")
   
6.         .Global = True
   
7.         .Pattern = pt
   
8.         If .test(txt) Then
   
9.             If k = 0 Then
   
10.                 TQ = .Replace(txt, s)
    
11.             ElseIf k > 0 Then
    
12.                 If InStr(k, ".") Then
    
13.                     Set Ma = .Execute(txt)
    
14.                     ReDim a(0 To Ma.Count - 1)
    
15.                     For Each m In Ma
    
16.                         a(c) = m: c = c + 1
    
17.                     Next
    
18.                     If s = "" Then s = " "
    
19.                     TQ = Join(a, s)
    
20.                 Else
    
21.                     TQ = .Execute(txt)(k - 1)
    
22.                 End If
    
23.             Else 'k < 0
    
24.                 If InStr(k, ".") Then
    
25.                     TQ = .Execute(txt)(Int(-k) - 1).SubMatches(Mid(k, InStr(k, ".") + 1) - 1)
    
26.                 Else
    
27.                     Set sMa = .Execute(txt)(-k - 1).SubMatches
    
28.                     ReDim b(0 To sMa.Count - 1)
    
29.                     For Each m In sMa
    
30.                         b(c) = m: c = c + 1
    
31.                     Next
    
32.                     If s = "" Then s = " "
    
33.                     TQ = Join(b, s)
    
34.                 End If
    
35.             End If
    
36.         Else
    
37.             If k = 0 And s = "" Then TQ = txt Else TQ = ""
    
38.         End If
    
39.     End With
    
40. End Function
    

复制代码