学习FSO及正则表达式从实例开始，陆续更新

win2009 · 发表于 2012-10-4 08:24

本帖最后由 win2009 于 2012-10-4 22:00 编辑

说明：以下代码和文字来源于网络，所有权和解释权归原作者，如有侵权将被删除
附件是两个很好的帮助，代码全部测试过，清理并简化了一些冗余代码，水平所限
难免出错，请高人斧正。不要嫌多，都看明白，你就会了，这里主要是完整的例子
你有好的代码，也贴到这里，以后需要就来这里查看，会很方便

JS55.rar (583.21 KB, 下载次数: 595)

VBS55.rar (514.67 KB, 下载次数: 615)
EXCEL VBA 正则表达式
先来点理论，这是扫盲理论，高手略过
1.正则表达式(Regular Expression)基础
　　正则表达式是通用的文本搜索和处理方案，它的知识不是VBA独有的，基本上每种语言都内置了正则表达式的功能。正则表达式的基础知识不是这里的重点
2.VBA中的正则表达式应用
　　在VBA中使用正则表达式，可以通过下列途径实现：
创建正则表达式对象:
前期绑定：在VBA代码编辑器中的"Tools"菜单中，选中"References..."，然后引用Microsoft VBScript Regular Expressions 5.5类库，然后直接定义对象：Dim reg As New RegExp。
后期绑定：使用CreateObject方法定义对象：CreateObject("VBSCRIPT.REGEXP")。
前一种方式的优点是可以有编辑器的Intellisense支持?
RegExp对象的属性:
Global - 设置或返回一个 Boolean 值，该值指明在整个搜索字符串时模式是全部匹配还是只匹配第一个。如果搜索应用于整个字符串，Global 属性的值应该为 True，否则其值为 False。默认的设置为True。
Multiline - 返回正则表达式是否具有标志m, 缺省值为False。如果指定的搜索字符串分布在多行，这个属性是要设置为True的。
IgnoreCase - 设置或返回一个Boolean值，指明模式搜索是否区分大小写。如果搜索是区分大小写的，则 IgnoreCase 属性应该为False；否则应该设为True。缺省值为True。
Pattern - 设置或返回被搜索的正则表达式模式。被搜索的正则字符串表达式。它包含各种正则表达式字符。
RegExp对象的方法:
Execute - 对指定的字符串执行正则表达式搜索。需要传入要在其上执行正则表达式的文本字符串。正则表达式搜索的设计模式是通过 RegExp对象的Pattern来设置的。Execute方法返回一个Matches集合，其中包含了在string中找到的每一个匹配的Match对象。如果未找到匹配，Execute将返回空的Matches集合。
Replace -替换在正则表达式查找中找到的文本?
Test - 对指定的字符串执行一个正则表达式搜索，并返回一个 Boolean 值指示是否找到匹配的模式。RegExp.Global属性对Test方法没有影响。如果找到了匹配的模式，Test方法返回True；否则返回False。
MatchCollection对象与Match对象
匹配到的所有对象放在MatchCollection集合中，这个集合对象只有两个只读属性：
Count: 匹配到的对象的数目
Item：集合的又一通用方法，需要传入Index值获取指定的元素。
一般，可以使用For Each语句枚举集合中的对象。集合中对象的类型是Match。
Match对象有以下几个只读的属性:
FirstIndex - 匹配字符串在整个字符串中的位置，值从0开始。
Length -匹配字符串的长度?
Value -匹配的字符串?
SubMatches - 集合，匹配字符串中每个分组的值。作为集合类型，有Count和Item两个属性。

常用的正则表达式主要有以下几种:
匹配中文字符的正则表达式:    [\u4e00-\u9fa5]
评注：匹配中文还真是个头疼的事，有了这个表达式就好办了
匹配双字节字符 (包括汉字在内): [^\x00-\xff]
评注：可以用来计算字符串的长度（一个双字节字符长度计2，ASCII字符计1）
匹配空白行的正则表达式：\n\s*\r
评注:    可以用来删除空白行
匹配HTML标记的正则表达式：<(\S*?)[^>]*>.*?</>|<.*? />
评注：网上流传的版本太糟糕，上面这个也仅仅能匹配部分，对于复杂的嵌套标记依旧无能为力
匹配首尾空白字符的正则表达式：^\s*|\s*$
评注：可以用来删除行首行尾的空白字符(包括空格、制表符、换页符等等)，非常有用的表达式
匹配Email地址的正则表达式：\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*
评注:    表单验证时很实用
匹配网址URL的正则表达式：[a-zA-z]+://[^\s]*
评注：网上流传的版本功能很有限，上面这个基本可以满足需求
匹配帐号是否合法(字母开头，允许5-16字节，允许字母数字下划线)：^[a-zA-Z][a-zA-Z0-9_]{4,15}$
评注:    表单验证时很实用
匹配国内电话号码：\d-\d|\d-\d
评注：匹配形式如 0511-4405222 或 021-87888822
匹配腾讯QQ号：[1-9][0-9]{4,}
评注:    腾讯QQ号从10000开始
匹配中国邮政编码：[1-9]\d(?!\d)
评注:    中国邮政编码为6位数字
匹配身份证：\d|\d
评注:    中国的身份证为15位或18位
匹配ip地址：\d+\.\d+\.\d+\.\d+
评注:    提取ip地址时有用
匹配特定数字:
^[1-9]\d*$　//匹配正整数
^-[1-9]\d*$ //匹配负整数
^-?[1-9]\d*$　//匹配整数
^[1-9]\d*|0$　//匹配非负整数（正整数 + 0）
^-[1-9]\d*|0$　//匹配非正整数（负整数 + 0）
^[1-9]\d*\.\d*|0\.\d*[1-9]\d*$　//匹配正浮点数
^-([1-9]\d*\.\d*|0\.\d*[1-9]\d*)$　//匹配负浮点数
^-?([1-9]\d*\.\d*|0\.\d*[1-9]\d*|0?\.0+|0)$　//匹配浮点数
^[1-9]\d*\.\d*|0\.\d*[1-9]\d*|0?\.0+|0$　//匹配非负浮点数（正浮点数 + 0）
^(-([1-9]\d*\.\d*|0\.\d*[1-9]\d*))|0?\.0+|0$　//匹配非正浮点数（负浮点数 + 0）
评注：处理大量数据时有用，具体应用时注意修正
匹配特定字符串:
^[A-Za-z]+$　//匹配由26个英文字母组成的字符串
^[A-Z]+$　//匹配由26个英文字母的大写组成的字符串
^[a-z]+$　//匹配由26个英文字母的小写组成的字符串
^[A-Za-z0-9]+$　//匹配由数字和26个英文字母组成的字符串
^\w+$　//匹配由数字、26个英文字母或者下划线组成的字符串
评注:    最基本也是最常用的一些表达式

代码/语法说明
匹配除换行符以外的任意字符  .
\w  匹配字母或数字或下划线或汉字
\s  匹配任意的空白符
\d  匹配数字
\b  匹配单词的开始或结束
^ 匹配字符串的开始
$ 匹配字符串的结束

表2.常用的限定符
代码/语法说明
* 重复零次或更多次
重复一次或更多次 +
Print 重复零次或一次
{n} 重复n次
{n,} 重复n次或更多次
{n,m} 重复n到m次

表3.常用的反义代码
代码/语法说明
\W  匹配任意不是字母，数字，下划线，汉字的字符
\S  匹配任意不是空白符的字符
\D  匹配任意非数字的字符
\B  匹配不是单词开头或结束的位置
[^x] 匹配除了x以外的任意字符
[^aeiou] 匹配除了aeiou这几个字母以外的任意字符

表4.常用分组语法
代码/语法说明分类
(exp) 匹配exp,并捕获文本到自动命名的组里  捕获
(?<name>exp) 匹配exp,并捕获文本到名称为name的组里，也可以写成(?'name'exp)
(?:exp) 匹配exp,不捕获匹配的文本，也不给此分组分配组号
(?<=exp)  匹配exp前面的位置零宽断言 (?=exp)  匹配exp后面的位置
(?!exp) 匹配后面跟的不是exp的位置
(?<!exp) 匹配前面不是exp的位置
(?#comment) 这种类型的分组不对正则表达式的处理产生任何影响，用于提供注释让人阅读注释

表5.懒惰限定符
代码/语法说明
*?  重复任意次，但尽可能少重复
+?  重复1次或更多次，但尽可能少重复
??  重复0次或1次，但尽可能少重复
{n,m}?  重复n到m次，但尽可能少重复
{n,}? 重复n次以上，但尽可能少重复

表6.常用的处理选项
名称说明
IgnoreCase(忽略大小写)  匹配时不区分大小写。
Multiline(多行模式) 更改^和$的含义，使它们分别在任意一行的行首和行尾匹配，而不仅仅在整个字符串的开头和结尾匹配。(在此模式下,$的精确含意是:匹配\n之前的位置以及字符串结束前的位置.)
Singleline(单行模式) 更改.的含义，使它与每一个字符匹配（包括换行符\n）。
IgnorePatternWhitespace(忽略空白) 忽略表达式中的非转义空白并启用由#标记的注释。
ExplicitCapture(显式捕获) 仅捕获已被显式命名的组。

表7.尚未详细讨论的语法
代码/语法说明
\a  报警字符(打印它的效果是电脑嘀一声)
\b  通常是单词分界位置，但如果在字符类里使用代表退格
\t  制表符，Tab
\r  回车
\v  竖向制表符
\f  换页符
\n  换行符
\e  Escape
\0nn ASCII代码中八进制代码为nn的字符
\xnn ASCII代码中十六进制代码为nn的字符
\unnnn  Unicode代码中十六进制代码为nnnn的字符
\cN ASCII控制字符。比如\cC代表Ctrl+C
\A  字符串开头(类似^，但不受处理多行选项的影响)
\Z  字符串结尾或行尾(不受处理多行选项的影响)
\z  字符串结尾(类似$，但不受处理多行选项的影响)
\G  当前搜索的开头
\p{name} Unicode中命名为name的字符类，例如\p{IsGreek}
(?>exp) 贪婪子表达式
(?<x>-<y>exp) 平衡组
(?im-nsx:exp) 在子表达式exp中改变处理选项
(?im-nsx) 为表达式后面的部分改变处理选项
(?(exp)yes|no)  把exp当作零宽正向先行断言，如果在这个位置能匹配，使用yes作为此组的表达式；否则使用no
(?(exp)yes) 同上，只是使用空表达式作为no
(?(name)yes|no) 如果命名为name的组捕获到了内容，使用yes作为表达式；否则使用no
(?(name)yes) 同上，只是使用空表达式作为no

在VBA中使用正则表达式，可以通过下列途径实现：
创建正则表达式对象:
前期绑定：在VBA代码编辑器中的"Tools"菜单中，选中"References..."，然后引用Microsoft VBScript Regular Expressions 5.5类库，然后直接定义对象：Dim reg As New RegExp。
后期绑定：使用CreateObject方法定义对象：CreateObject("VBSCRIPT.REGEXP")。
前一种方式的优点是可以有编辑器的Intellisense支持?
RegExp对象的属性:
Global - 设置或返回一个 Boolean 值，该值指明在整个搜索字符串时模式是全部匹配还是只匹配第一个。如果搜索应用于整个字符串，Global 属性的值应该为 True，否则其值为 False。默认的设置为True。
Multiline - 返回正则表达式是否具有标志m, 缺省值为False。如果指定的搜索字符串分布在多行，这个属性是要设置为True的。
IgnoreCase - 设置或返回一个Boolean值，指明模式搜索是否区分大小写。如果搜索是区分大小写的，则 IgnoreCase 属性应该为False；否则应该设为True。缺省值为True。
Pattern - 设置或返回被搜索的正则表达式模式。被搜索的正则字符串表达式。它包含各种正则表达式字符。
RegExp对象的方法:
Execute - 对指定的字符串执行正则表达式搜索。需要传入要在其上执行正则表达式的文本字符串。正则表达式搜索的设计模式是通过 RegExp对象的Pattern来设置的。Execute方法返回一个Matches集合，其中包含了在string中找到的每一个匹配的Match对象。如果未找到匹配，Execute将返回空的Matches集合。
Replace -替换在正则表达式查找中找到的文本?
Test - 对指定的字符串执行一个正则表达式搜索，并返回一个 Boolean 值指示是否找到匹配的模式。RegExp.Global属性对Test方法没有影响。如果找到了匹配的模式，Test方法返回True；否则返回False。
MatchCollection对象与Match对象
匹配到的所有对象放在MatchCollection集合中，这个集合对象只有两个只读属性：
Count: 匹配到的对象的数目
Item：集合的又一通用方法，需要传入Index值获取指定的元素。
一般，可以使用For Each语句枚举集合中的对象。集合中对象的类型是Match。
Match对象有以下几个只读的属性:
FirstIndex - 匹配字符串在整个字符串中的位置，值从0开始。
Length -匹配字符串的长度?
Value -匹配的字符串?
SubMatches - 集合，匹配字符串中每个分组的值。作为集合类型，有Count和Item两个属性。

正则表达式很强大，是处理文本的首选，不管你信不信，反正我是信了。说了很多，
最后以一个小例子结尾吧:

Sub Test()
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = True
.Pattern = "\d+"
End With
Dim mc As MatchCollection
Dim m As match
Set mc = reg.Execute("123aaaaa987uiiui999")
For Each m In mc
MsgBox m.Value
Next
End Sub

复制代码

win2009 · 发表于 2012-10-4 08:26

本帖最后由 win2009 于 2012-10-16 21:09 编辑

正则表达式的3个典型代码

Function ExReplace(sStr As String, sReplStr As String, sPatrn As String) As String
'正则表达式替换
'参数说明：sStr原字符串，sReplStr将替换的字符串，sPatrn样式
'返回参数，返回替换后的值
Dim regEX As Object
Set regEX = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
regEX.Global = True '设置全局可用
regEX.Pattern = sPatrn '设置样式
ExReplace = regEX.Replace(sStr, sReplStr) '执行替换
Set regEX = Nothing
End Function
Function ExExce(sStr As String, sPatrn As String, Optional IC As Boolean = True, Optional G As Boolean = True) As Object
'正则表达式搜索
'参数说明：sStr原字符串，Patrn样式,IC是否区别大小写,G是否全局可用
'返回参数，返回的是一个对象，ExExce.Count是搜索的数量
' ExExce(n).FirstIndex搜索的第n个串的位置，n>=0
' ExExce(n).Value搜索的第n个串的值，n>=0
Dim regEX As Object
Set regEX = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
regEX.Global = True '设置全局可用
regEX.Pattern = sPatrn '设置样式
regEX.IgnoreCase = IC '设置是否区分大小写。
Set ExExce = regEX.Execute(sStr) '执行搜索
Set regEX = Nothing
End Function
Function ExTest(sStr As String, sPatrn As String, IC As Boolean) As Boolean
'正则表达式匹配
'VBA代码
'参数说明：sStr原字符串，Patrn样式,IC是否区别大小写
'返回参数，返回一个逻辑值，True为匹配，False为不匹配
Dim regEX As Object
Set regEX = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
regEX.Global = True '设置全局可用
regEX.Pattern = sPatrn '设置样式
regEX.IgnoreCase = IC '设置是否区分大小写。
ExTest = regEX.Test(sStr) '执行搜索测试
Set regEX = Nothing
End Function

复制代码

win2009 · 发表于 2012-10-4 08:30

Public Sub 去重复()
Dim ss, re, rv
ss = "Is is the cost of of gasoline going up up?." & vbNewLine
Set re = New RegExp
re.Pattern = "\b([a-z]+) \1\b"
re.Global = True
re.IgnoreCase = True
re.MultiLine = True
rv = re.Replace(ss, "$1")
MsgBox rv
End Sub

复制代码

Function RegExpTest(patrn, strng)
'正则表达式(RegExp)对象
'提供简单的正则表达式支持功能?
'下面的代码说明了RegExp对象的用法:
Dim regEX, match, matches ' 建立变量。
Set regEX = New RegExp ' 建立正则表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = True ' 设置是否区分字符大小写。
regEX.Global = True ' 设置全局可用性。
Set matches = regEX.Execute(strng) ' 执行搜索。
For Each match In matches ' 遍历匹配集合。
retStr = retStr & "Match found at position "
retStr = retStr & match.FirstIndex & ". Match Value is '"
retStr = retStr & match.Value & "'." & vbCrLf
Next
RegExpTest = retStr
End Function

复制代码

'Global 属性
'设置或返回一个 Boolean 值，该值指明在整个搜索字符串时模式是全部匹配还是只匹配第一个。
'Object.Global [= True | False ]
'对象参数总是 RegExp 对象。如果搜索应用于整个字符串，Global 属性的值为 True，否则其值为 False。默认的设置为 False。
'下面的代码说明了 Global 属性的用法（改变赋予 Global 属性的值并观察其效果）：
Function RegExpTest1(patrn, strng)
Dim regEX, match, matches ' 建立变量。
Set regEX = New RegExp ' 建立规范表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = True ' 设置是否区分字母的大小写。
regEX.Global = True ' 设置全程性质。
Set matches = regEX.Execute(strng) ' 执行搜索。
For Each match In matches ' 重复匹配集合
retStr = retStr & "Match found at position "
RetStr=RetStr&Match.FirstIndex&".Match Value is '"
RetStr=RetStr&Match.Value&"'."&vbCRLF Next
RegExpTest = retStr
End Function

复制代码

'IgnoreCase 属性
'设置或返回一个Boolean值，指明模式搜索是否区分大小写。
'Object.IgnoreCase [= True | False ]
'Object 参数总是一个 RegExp 对象。如果搜索是区分大小写的，则 IgnoreCase 属性为 False；否则为 True。缺省值为 False。
'说明
'下面的代码说明了 IgnoreCase 属性的用法（改变赋予 IgnoreCase 属性的值以观察其效果)：
Function RegExpTest2(patrn, strng)
Dim regEX, match, matches ' 建立变量。
Set regEX = New RegExp ' 建立正则表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = True ' 设置不区分大小写。
regEX.Global = True ' 设置全局可用性
Set matches = regEX.Execute(strng) ' 执行搜索。
For Each match In matches ' 重复匹配集合
retStr = retStr & "Match found at position "
RetStr=RetStr&Match.FirstIndex&".Match Value is '"
RetStr=RetStr&Match.Value&"'."&vbCRLF
Next
RegExpTest = retStr
End Function

复制代码

'Execute 方法
'对指定的字符串执行正则表达式搜索?
'object.Execute(string)
'参数
'Object
'必选项。总是一个 RegExp 对象的名称。
'string
'必选项?要在其上执行正则表达式的文本字符串?
'说明
'正则表达式搜索的设计模式是通过 RegExp 对象的 Pattern 来设置的。
'Execute 方法返回一个 Matches 集合，其中包含了在 string 中找到的每一个匹配的 Match 对象。如果未找到匹配，Execute 将返回空的 Matches 集合。
'下面的代码说明了 Execute 方法的用法。
Function RegExpTest3(patrn, strng)
Dim regEX, match, matches ' Create variable.
Set regEX = New RegExp ' Create a regular expression.
regEX.Pattern = patrn ' Set pattern.
regEX.IgnoreCase = True ' Set case insensitivity.
regEX.Global = True ' Set global applicability.
Set matches = regEX.Execute(strng) ' Execute search.
For Each match In matches ' Iterate Matches collection.
retStr = retStr & "Match found at position "
retStr = retStr & match.FirstIndex & ". Match Value is '"
retStr = retStr & match.Value & "'." & vbCrLf
Next
RegExpTest = retStr
End Function

复制代码

'Replace 方法
'替换在正则表达式查找中找到的文本?
'object.Replace(string1, string2)
'参数
'Object
'必选项。总是一个 RegExp 对象的名称。
'string1
'必选项?string1 是将要进行文本替换的字符串?
'string2
'必选项。 string2 是替换文本字符串。
'说明
'被替换的文本的实际模式是通过 RegExp 对象的 Pattern 属性设置的。
'Replace 方法返回 string1 的副本，其中的 RegExp.Pattern 文本已经被替换为 string2。如果没有找到匹配的文本，将返回原来的 string1 的副本。
'下面的例子说明了 Replace 方法的用法。
Function ReplaceTest4(patrn, replStr)
Dim regEX, str1 ' 建立变量。
str1 = "The quick brown fox jumped over the lazy dog."
Set regEX = New RegExp ' 建立正则表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = True ' 设置是否区分大小写。
ReplaceTest = regEX.Replace(str1, replStr) ' 作替换。
End Function
'MsgBox(ReplaceTest("fox", "cat")) ' 将 'fox' 替换为 'cat'。
'；另外，Replace 方法在模式中替换 subexpressions 。下面对以前示例中函数的调用，替换了原字符串中的所有字对：
'MsgBox (ReplaceText("(\S+)(\s+)(\S+)", "$3$2$1")) ' 交换词对.

复制代码

'test 方法
'对指定的字符串执行一个正则表达式搜索，并返回一个 Boolean 值指示是否找到匹配的模式。
'object.Test(string)
'参数
'Object
'必选项。总是一个 RegExp 对象的名称。
'string
'必选项?要执行正则表达式搜索的文本字符串?
'说明
'正则表达式搜索的实际模式是通过RegExp对象的Pattern属性来设置的?RegExp.Global属性对Test方法没有影响?
'如果找到了匹配的模式，Test方法返回True；否则返回False。
'下面的代码说明了Test 方法的用法?
Function RegExpTest5(patrn, strng)
Dim regEX, retVal ' 建立变量。
Set regEX = New RegExp ' 建立正则表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = False ' 设置是否区分大小写。
retVal = regEX.Test(strng) ' 执行搜索测试。
If retVal Then
RegExpTest = "找到一个或多个匹配。"
Else
RegExpTest = "未找到匹配。"
End If
End Function

复制代码

'MsgBox (RegExpTest("is.", "IS1 is2 IS3 is4"))
'Match 对象
'提供了对正则表达式匹配的只读属性的访问?
'说明
'Match 对象只能通过 RegExp 对象的 Execute 方法来创建，该方法实际上返回了 Match 对象的集合。所有的 Match 对象属性都是只读的。
'在执行正则表达式时，可能产生零个或多个 Match 对象。每个 Match 对象提供了被正则表达式搜索找到的字符串的访问、字符串的长度，以及找到匹配的索引位置等。
'下面的代码说明了 Match 对象的用法：
Function RegExpTest6(patrn, strng)
Dim regEX, match, matches ' 建立变量。
Set regEX = New RegExp ' 建立正则表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = True ' 设置是否区分大小写。
regEX.Global = True ' 设置全局替换。
Set matches = regEX.Execute(strng) ' 执行搜索。
For Each match In matches ' 遍历 Matches 集合。
retStr = retStr & "Match " & i & " found at position "
retStr = retStr & match.FirstIndex & ". Match Value is " '
retStr = retStr & match.Value & "'." & vbCrLf
Next
RegExpTest = retStr
End Function

复制代码

'Matches 集合
'正则表达式 Match 对象的集合。
'
'说明
'Matches 集合中包含若干独立的 Match 对象，只能使用 RegExp 对象的 Execute 方法来创建之。与独立的 Match 对象属性相同，Matches `集合的一个属性是只读的。
'
'在执行正则表达式时，可能产生零个或多个 Match 对象。每个 Match 对象都提供了与正则表达式匹配的字符串的访问入口、字符串的长度，以及标识匹配位置的索引。
'
'下面的代码将说明如何使用正则表达式查找获得 Matches 集合，以及如何循环遍历集合：
Function RegExpTest7(patrn, strng)
Dim regEX, match, matches ' 创建变量。
Set regEX = New RegExp ' 创建正则表达式。
regEX.Pattern = patrn ' 设置模式。
regEX.IgnoreCase = True ' 设置是否区分大小写。
regEX.Global = True ' 设置全程匹配。
Set matches = regEX.Execute(strng) ' 执行搜索。
For Each match In matches ' 循环遍历Matches集合。
retStr = retStr & "Match found at position "
retStr = retStr & match.FirstIndex & ". Match Value is '"
retStr = retStr & match.Value & "'." & vbCrLf
Next
RegExpTest = retStr
End Function

复制代码

'SubMatches8 集合
'正则表达式子匹配字符串的集合?
'说明
'SubMatches 集合包含了单个的子匹配字符串，只能用 RegExp 对象的 Execute 方法创建。SubMatches 集合的属性是只读的。
'运行一个正则表达式时，当圆括号中捕捉到子表达式时可以有零个或多个子匹配。
'SubMatches 集合中的每一项是由正则表达式找到并捕获的的字符串。
'下面的代码演示了如何从一个正则表达式获得一个 SubMatches 集合以及如何操作它的专有成员：
Sub MatchTest8()
inpStr = "dragon@xyzzy.com"
Dim oRe, oMatch, oMatches
Set oRe = New RegExp
' 查找一个电子邮件地址（不是一个理想的 RegExp）
oRe.Pattern = "(\w+)@(\w+)\.(\w+)"
' 得到 Matches 集合
Set oMatches = oRe.Execute(inpStr) '因为只有一个地址，所以，集合只有一项，就是索引=0的那个
' 得到 Matches 集合中的第一项
Set oMatch = oMatches(0)
' 创建结果字符串。
' Match 对象是完整匹配 — dragon@xyzzy.com
retStr = "电子邮件地址是： " & oMatch & vbNewLine
' 得到地址的子匹配部分。
retStr = retStr & "电子邮件别名是： " & oMatch.SubMatches(0) ' dragon
retStr = retStr & vbNewLine
retStr = retStr & "组织是： " & oMatch.SubMatches(1) ' xyzzy
SubMatchTest = retStr
MsgBox retStr
End Sub

复制代码

win2009 · 发表于 2012-10-4 08:34

Sub jj1()
'把数字筛选出来不包含括号的数字
Dim kk()
Set x = CreateObject("vbscript.regexp")
x.Global = 1
x.Pattern = "^(.*?)\(.*?"
j = 1
For Each y In [a2:h2]
ReDim Preserve kk(1 To j)
If x.Test(y) Then
Set mchs = x.Execute(y)
Set mc = mchs(0)
retStr = mc.SubMatches(0)
kk(j) = Val(retStr)
j = j + 1
End If
Next
MsgBox Application.Min(kk)
End Sub

复制代码

Sub jj()
'把数字筛选出来不包含括号的数字
Dim kk()
Set x = CreateObject("vbscript.regexp")
x.Global = 1
x.Pattern = "^(.*?)\(.*?"
j = 1
For Each y In [a2:h2]
ReDim Preserve kk(1 To j)
If x.Test(y) Then
kk(j) = Val(x.Execute(y)(0).SubMatches(0))
j = j + 1
End If
Next
MsgBox Application.Min(kk)
End Sub

复制代码

Sub 删除空格()
Dim reg As Object
Dim arr
Dim i As Integer
rw = Range("A65536″).End(xlUp).Row
Columns("B").ClearContents
arr = Range("A1:A" & rw)
Set reg = CreateObject("VBscript.RegExp")
With reg
.Global = True
.IgnoreCase = True
.Pattern = "^ " '符合样式就用""替换
End With
For i = 1 To UBound(arr)
Range("B" & i) = reg.Replace(arr(i, 1), "")
Next
End Sub

复制代码

' 正则表达式示例1 提取字符串中的数字
Sub getNum1()
' 这种使用方式需要"工具""引用"
' 引用Microsoft VBScript Regular Expressions 5.5类库
Dim reg As New RegExp
With reg
.Global = True
.IgnoreCase = True
.Pattern = "\d+"
End With
Dim mc As MatchCollection
Dim m As match
Set mc = reg.Execute("123aaaaa987uiiui999")
For Each m In mc
MsgBox m.Value + 1
Next
End Sub

复制代码

' 正则表达式示例2 用"字符串"替换原字符串中符合匹配模式的部分
Sub getNum2()
Dim arr
arr = Split("A12B-R1E2W-E1T-R2T-Q1B2Y3U4D", "-") ' split(字符串,"分隔符")拆分字符串
With CreateObject("VBSCRIPT.REGEXP") ' 生成一个正则表达式对象实例
For i = 0 To UBound(arr)
.Global = True ' 设置全局可用，即替换所有符合匹配模式的字符串
.Pattern = "[^A-Z]" ' 匹配模式为非大写字母
sr = .Replace(arr(i), "") ' 将arr(i)字符串中符合匹配模式的部分替换为空字符
c = c & sr & " "
Next
End With
MsgBox c
End Sub

复制代码

Function zldccmx(rng As Range, Ms As Integer)
Dim ys(1 To 12): Dim regEX
ys(1) = "[^A-Za-z0-9]" '只保留字母和数字
ys(2) = "[^!-~]" '去除中文
ys(3) = "[!-~]" '"\w" '留中文
ys(4) = "\d" ' 去掉数字
ys(5) = "[^\d]" ' 留数字
ys(6) = "\D" '去除非数字(留数字)
ys(7) = "[a-zA_Z]" '去除英文大小写字符
ys(8) = "3*a*" '去除所有指定字符，这里指去除3和a
ys(9) = "36*" '去除所有指定字符，这里指去除"36"
ys(10) = "[^3]" '去除所有非特定字符，这里指去除不是3的字符
ys(11) = "[^0-9.]" '只保留数字和小数点
ys(12) = "[^0-9/.+-^\*^]" '保留数字和运算符号+-*/^
Set regEX = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
regEX.Global = True '设置全局可用
regEX.Pattern = ys(Ms) '样式
zldccmx = regEX.Replace(rng, "")
Set regEX = Nothing
End Function

复制代码

'问题: 字符串中1个或者连续多个空格替换成一个Tab键
'分析：由于字符串中连续的空格的个数不太确定，如果我们逐个字符去分析的话，
'也是比较麻烦的，但如果用正则去实现，则简单的多。这也是一个典型的适合用正则解决的问题。
'解决方式如下：
Sub Test7()
Dim regEX As Object, str
str = "abc de fg"
Set regEX = CreateObject("vbscript.regexp")
With regEX
.Global = True
.Pattern = "\s+"
End With
st = regEX.Replace(str, " ")
MsgBox st
Set regEX = Nothing
End Sub
Sub test1()
Dim str
Set reg = CreateObject("VBScript.RegExp")
reg.Global = True
reg.Pattern = "\d{9}"
str = "aaaaaaa123456789qqqqqqqqqqqq234567891aaaa12345678"
Set col = reg.Execute(str)
If col.Count > 0 Then
For Each mch In col
sm = sm & mch.Value & " "
Next
End If
MsgBox sm
End Sub
Sub r_1()
' 1) Global 属性
' False，如果找到匹配的字符，就停止搜索（默认值）
' True ，搜索字符串中全部字符
Dim regEX As Object
Dim x As String
x = "a1b2c3"
Set regEX = CreateObject("VBScript.RegExp")
With regEX
.Global = True '返回"a#b#c#"
' .Global = False '返回"a#b2c3"
.Pattern = "\d" '数字字符匹配
MsgBox .Replace(x, "#")
End With
End Sub

复制代码

'2) IgnoreCase 属性
'如果搜索是区分大小写的，为False（缺省值）
'True不分
Sub r_2()
Dim regEX As Object
Dim x As String
x = "a1A2"
Set regEX = CreateObject("VBScript.RegExp")
With regEX
.Global = True
.IgnoreCase = True '返回"#1#2"
'.IgnoreCase = False '返回"ab#2"
.Pattern = "A" '数字字符匹配
MsgBox .Replace(x, "#")
End With
End Sub

复制代码

'3) Multiline 属性
' 返回正则表达式是否具有标志m , 缺省值为False
Sub r_3()
Dim regEX As Object
Dim x As String
x = "a1b2" & Chr(13) & "c3d4"
Set regEX = CreateObject("VBScript.RegExp")
With regEX
.Global = True '
.MultiLine = True
.Pattern = "\d+$"
MsgBox .Replace(x, "#")
End With
End Sub

复制代码

'4) Pattern 属性
' 一个字符串，用来定义正则表达式。缺省值为空文本。
'5) Execute 方法
' 返回一个 MatchCollection 对象，该对象包含每个成功匹配的 Match 对象。
Sub r_5()
Dim regEX As Object
Dim matchs As Object, match As Object
Dim x As String, y As String
x = "a1b2c3"
Set regEX = CreateObject("VBScript.RegExp")
With regEX
.Global = True
.Pattern = "\d" '匹配数字
Set matchs = .Execute(x)
For Each match In matchs
y = y & match
Next
End With
MsgBox y 'y返回123
End Sub

复制代码

win2009 · 发表于 2012-10-4 08:37

'6) Test 方法
' 返回一个布尔值，该值指示正则表达式是否与字符串成功匹配。
Sub r_6()
Dim regEX As Object
Dim x As String, y As String
Dim i As Integer
x = "a1b2c3"
Set regEX = CreateObject("VBScript.RegExp")
With regEX
.Global = True
.Pattern = "\d"
For i = 1 To Len(x)
If .Test(Mid(x, i, 1)) Then y = y & Mid(x, i, 1)
Next i
End With
MsgBox y 'y返回123
End Sub

复制代码

Public Sub ty2() '提取英文字母并去重复
Dim arr, i&, y, str$
str = "$A$8,$D$11,$D$5,,$D$10,$G$12"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[$,0-9]"
str = .Replace(str, "")
.Pattern = "(.)\1{1,}"
str = .Replace(str, "$1")
End With
Debug.Print str
End Sub

复制代码

'把文件中的空白行去掉:假设d盘有一个文本text.txt,内容如下
'
'8 5 4 1 6 3 2 7 9
'
'7 6 2 9 5 8 3 4 1
'
'9 3 1 4 2 7 8 5 6
'
'
'
'6 9 3 8 7 5 1 2 4
'
'5 1 8 3 4 2 6 9 7
'
'2 4 7 6 1 9 5 3 8
'
'
'
'3 26 7 8 4 9 1 5
'
'4 8 9 5 3 1 7 6 2
'
'1 7 5 2 9 6 4 8 3
'
'正则表达式：\r\n\r\n
'
'分析：\r\n匹配一个回车+换行组合，windows操作系统中把它作为文本行的结束标签。
'使用正则表达式\r\n\r\n进行的搜索将匹配两个连续的行尾标签，而这正好是空白行。
'注意：Unix和Linux操作系统中只使用一个换行符来结束一个文本行，换句话说，
'在Unix或Linux系统中匹配空白行只使用\n\n即可，不需要加上\r
Sub test8()
f = "d:\Text.txt"
s = CreateObject("scripting.FileSystemObject").OpenTextFile(f, 1, 1, -2).ReadAll
With CreateObject("VBSCRIPT.REGEXP")
.Global = True
.Pattern = "(\r\n){2}"
CreateObject("scripting.FileSystemObject").OpenTextFile(f, 2, 1).Write .Replace(s, "")
End With
End Sub

复制代码

'例1、有如下一组电话号码，如何改变成右侧的样式。
':假设d盘有一个文本text.txt,内容如下
'(020)12345678 020-12345678
'(021)32145678 021-32145678
'(0371)45678129 0371-45678129
'(0392)1234567 0392-1234567
'(010)21458965 010-21458965
'(0393)45987636 0393-45987636
'(0372)87654321 0372-87654321
Sub ff()
f = "d:\Text.txt"
s = CreateObject("scripting.FileSystemObject").OpenTextFile(f, 1, 1, -2).ReadAll
With CreateObject("VBSCRIPT.REGEXP")
.Global = True
.Pattern = "$(\d{3,4})$(\d+)" '设置正则表达式
CreateObject("scripting.FileSystemObject").OpenTextFile(f, 2, 1).Write .Replace(s, "$1-$2")
End With
End Sub
'正则表达式的三步曲应该是：1、查找；2、引用匹配了的文本(后向引用)；3、有选择地替换文本。
'案例:
'我们的电话格式通常都是：(区号)电话，比如说：(029)8401132；现在假设我们要求把文本中所有的电话格式都改为：029-8401132，我们可以这样做：
'Text
'(020)82514769
'(021)83281314
'(029)88401132
'regEX
'$(\d{3})$(\d{8})
'注：这段其实也可以写成$\d{3}$\d{8}，之所以给\d{3}和\d{8}分别用括号加起来，是因为替换的时候需要引用括号里面的内容。
'Replace
'$1-$2
'注：大部分语言的正则表达式实现，在查找中，使用后向引用来代表一个子模式，其语法是“\数字”；而在替换中，其语法是“$数字”。
'所以$1就表示引用刚才匹配到的第一部分，$2是匹配到的第二部分，中间用连字符-。
'Result
'020-82514769
'021-83281314
'029-88401132

复制代码

'提取括号里的百分数的数字（即匹配结果为0.39）
Sub tes2()
Dim str As String
str = "M4.1 點缺陷*7(0.39%)"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = ".+$(\d+\.?\d*)%$"
MsgBox .Replace(str, "$1") '符合模式的为：(0.39%)，替换后=0.39
End With
End Sub

复制代码

'取出末尾两个数字 30 CAC0040 取出40
Sub tes3()
Dim str As String
str = "30 CAC0040 取出40"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\d+$"
MsgBox .Execute(str)(0)
End With
End Sub

复制代码

'统一空格个数
Public Sub tongyi()
Dim str
str = "script type = text/javascript"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\s+"
MsgBox .Replace(str, " ")
End With
End Sub

复制代码

'判断字符串是不是由数字组成
Public Sub pd()
Dim str, ExTest
str = "123456"
With CreateObject("vbscript.regexp")
.Global = True '设置全局可用
.Pattern = "^\d*$" '设置样式
ExTest = .Test(str) '执行搜索测试
MsgBox ExTest
End With
End Sub

复制代码

[/code]
[code]'老朽的作品 0-4为小，5-9为大
'将 "1237865409" 转换成 "小小小大大大大小小大"
Sub zldcc()
a = "1237865409"
Set regEX = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
regEX.Global = True '设置全局可用
regEX.Pattern = "[0-4]" '样式"
a = regEX.Replace(a, "小")
regEX.Pattern = "[5-9]" '样式"
MsgBox regEX.Replace(a, "大")
End Sub

复制代码

'firstindex属性，怎么理解
Sub match()
Dim reg As Object
Dim s As String
Dim i As Byte
Dim match As Object, matches As Object
Set reg = CreateObject("vbscript.regexp")
s = "a11b22c32d43e"
i = 1
With reg
.Global = True
.Pattern = "\d+"
Set matches = .Execute(s)
End With
For Each match In matches
MsgBox "matches集合中第" & i & "个元素在字符串中" & vbCrLf _
& "位置：" & match.FirstIndex & vbCrLf _
& "长度为：" & match.Length & vbCrLf _
& "值为：" & match.Value
i = i + 1
Next
End Sub

复制代码

'这个能否取出字符串“右8-4、7-3、6-2、6-1“中两个数字加一个-：8-4 等
Function tiqu(rng As Range, n As Integer)
Set regx = CreateObject("VBscript.regexp")
With regx
.Global = True
.Pattern = "\d+-\d+"
Set matchs = .Execute(rng)
tiqu = matchs.Item(n)
End With
End Function

复制代码

win2009 · 发表于 2012-10-4 08:38

本帖最后由 win2009 于 2012-10-16 21:15 编辑

'只留中文字符、英文字符和数字
Sub cc()
Dim i%, arr
R = "454fdfgh,.;'我们，！！·"
With CreateObject("VBSCRIPT.REGEXP")
      .Global = True
      .Pattern = "[^\w]"
      s = .Replace(R, " ")
      .Pattern = "_"
      MsgBox .Replace(s, " ")
End With
End Sub
'去掉左右的abc，而不配取两边的abc
Sub tes5()
Dim str As String
str = "abcddd fffabc eeabcee hhabchh kkkabc"
With CreateObject("vbscript.regexp")
      .Global = True
      .Pattern = "\Babc\B"
      MsgBox .Replace(str, "")
End With
End Sub

网址：http://club.excelhome.net/thread-932174-1-1.html
标题：Excel 有关字符串的分隔问题~！求助。-ExcelVBA程序开发-Excel Home论坛 -
'学习一下
'注：只翻译【最佳答案】和【疑问】帖
Public Sub ret()
Dim regex, result    ' 声明变量
Set regex = New RegExp ' 创建对象
regex.Pattern = "(\d+)"
regex.Global = True
result = regex.Replace("怡景花园1栋10门10层02室", "、$1、")
MsgBox result
End Sub
公有的过程 ret()
定义变量 regex ,result
设置 regex = 新的正则表达式
regex . 样式 = "(\d+)"
regex . 全局 = 真
result = regex . 替换字符串("怡景花园1栋10门10层02室" ,"  ，匹配字符串的结束1  ，")
消息框： result
结束过程
==================
2012-10-16 20:49:09
==================
Function 拼音首字母(ByVal r As Range) As String
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
Dim i As Integer, j As Integer, temp As String
For i = 1 To Len(r)
      temp = Mid(r, i, 1)
      If temp <> " " And Asc(temp) < 0 Then
         If temp = "座" Then temp = "Z"
         For j = 1 To 23
            If Asc(temp) >= Asc(Mid(hanzi, j, 1)) And Asc(temp) < Asc(Mid(hanzi, j + 1, 1)) Then temp = Mid(hanzi, 24 + j, 1)
         Next
         Py = Py & temp
      End If
Next
拼音首字母 = LCase(Py)
End Function

sunny_8848 · 发表于 2012-10-4 08:39

多谢楼主的讲座

zhyj_88 · 发表于 2012-10-4 09:02

(?=exp) 匹配exp前面的位置零宽断言
(?<=exp) 匹配exp后面的位置
------------
这两个说明应是错误的。正确的应为：
(?=exp) 匹配exp后面的位置
(?<=exp) 匹配exp前面的位置

win2009 · 发表于 2012-10-4 09:05

本帖最后由 win2009 于 2012-10-7 00:49 编辑

复制代码

VBA使用FileSystemObject将读取或写入文本文件.rar (57.09 KB, 下载次数: 146)

'FSO能干什么？
Sub 读取某一行()
file_name = "d:\Text.txt"
n = 5
If n < 1 Then Exit Sub
Dim fso, f, temp_str, str
Set fso = CreateObject("scripting.filesystemobject")
If Not fso.FileExists(file_name) Then Exit Sub
Set f = fso.OpenTextFile(file_name, 1)
If Not f.AtEndOfStream Then
str = f.ReadAll
f.Close
Set f = Nothing
temp_str = Split(str, vbCrLf)
If n > UBound(temp_str) + 1 Then
Exit Sub
Else
MsgBox temp_str(n - 1)
End If
End If
End Sub
Sub 读取某n行()
file_name = "d:\Text.txt"
n = 4
If n < 1 Then Exit Sub
Dim fso, f, temp_str, str
Set fso = CreateObject("scripting.filesystemobject")
If Not fso.FileExists(file_name) Then Exit Sub
Set f = fso.OpenTextFile(file_name, 1)
If Not f.AtEndOfStream Then
str = f.ReadAll
f.Close
Set f = Nothing
temp_str = Split(str, vbCrLf)
For i = 0 To n
st = temp_str(i)
c = c & st & vbCrLf
Next
MsgBox c
End If
End Sub

不会就学哈 · 发表于 2012-10-4 09:24

先收藏了。

		自动登录	找回密码
密码			免费注册

[分享] 学习FSO及正则表达式从实例开始，陆续更新

评分

评分

评分

评分