ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 9000|回复: 13

[分享] 网页分析基础---正则表达式在VBA中的基础运用

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-1-11 21:56 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:文本处理和正则
'引用了Microsoft VBScript Regular Expressions 5.5 后就可以声明正则相关对象了。主要有三个对象:RegExp、MatchCollection、Match。
  
    '1. RegExp 这是VB使用正则表达式匹配模式的主要对象了。其提供的属性用于设置那些用来比较的传递给 RegExp 实例的字符串的模式。 其提供的方法以确定字符串是否与正则表达式的特定模式相匹配。

    '属性:
    'Pattern:一个字符串,用来定义正则表达式。
    'IgnoreCase:一个布尔值属性,指示是否必须对一个字符串中的所有可能的匹配进行正则表达式测试。这是MS的解释,有点费解,实际使用中的实例是,如果True,则忽略英文字母大小的匹配,False对大小写进行匹配。
    'Global:设置一个布尔值或返回一个布尔值,该布尔值指示一个模式是必须匹配整个搜索字符串中的所有搜索项还是只匹配第一个搜索项。
    'MultiLine:这个MS没有介绍。查了一下资料,设置一个布尔值或返回一个布尔值,是否在串的多行中搜索。如果允许匹配多行文本,则multiline为true,如果搜索必须在换行时停止,则为false 。

    '方法:
    'Execute:返回一个 MatchCollection 对象,该对象包含每个成功匹配的 Match 对象。
    'Replace:MS没有介绍,这是返回一个将匹配字符替换为指定字符的字符串。
    'Test:返回一个布尔值,该值指示正则表达式是否与字符串成功匹配。

    '2. MatchCollection 是集合对象,包含有关匹配字符串的信息,该对象包含每个成功匹配的 Match 对象。

    '属性
    'Count:     匹配对象的总数?
    'Item:      匹配对象的索引?

    '3. Match 是成功匹配的对象。

    '属性:
    'FirstIndex: 匹配对象所匹配字符串的起始位置?
    'Length:     匹配对象所匹配字符串的字符长度?
    'SubMatches: 匹配对象所匹配结果的子项?
    'Value:      匹配对象所匹配的值?



Sub dd()
        Dim s As String
        Dim p As String
        Dim reg As RegExp 'VB使用正则表达式匹配模式的主要对象
        Dim mc  As MatchCollection '是集合对象,包含有关匹配字符串的信息,该对象包含每个成功匹配的 Match 对象
        Dim m   As Match '成功匹配的对象
        Dim sms As SubMatches '匹配对象所匹配结果的子项
        Dim i As Long
        
        s = "我女朋友的生日是:1983-11-12 "
        p = "([\d]{4})-([\d]{2})-([\d]{2}) "
        
        Set reg = New RegExp
        reg.Pattern = p 'pattern:一个字符串,用来定义正则表达式
        Set mc = reg.Execute(s) 'Execute:返回一个 MatchCollection 对象,该对象包含每个成功匹配的 Match 对象
        
        For Each m In mc
                MsgBox m.Value
               
                Set sms = m.SubMatches
                For i = 0 To sms.Count - 1
                        MsgBox sms.Item(i)
                Next i
                Set sms = Nothing
        Next m
        Set mc = Nothing
        
        Set reg = Nothing
        
End Sub
Function bTest(ByVal s As String, ByVal p As String) As Boolean
    Dim re As RegExp
    Set re = New RegExp
    re.IgnoreCase = False  '设置是否匹配大小写
    re.Pattern = p
    bTest = re.Test(s)
End Function

Private Sub Command1_Click()

    Dim s As String
    Dim p As String
        
    s = "我的邮箱: test@163.com 。欢迎致电!"

    '测试字符串中是否包含数字:
    p = "\d+"
    MsgBox bTest(s, p)

    '测试字符串中是否全是由数字组成:
    p = "^\d+$"
    MsgBox bTest(s, p)

    '测试字符串中是否有大写字母:
    p = "[A-Z]+"
    MsgBox bTest(s, p)
   
End Sub

Function StrReplace(s As String, p As String, r As String) As String
   
    Dim re As RegExp
    Set re = New RegExp
    re.IgnoreCase = True
    re.Global = True
    re.Pattern = p
    StrReplace = re.Replace(s, r)
   
End Function

Private Sub Command2_Click()

    Dim s As String     '字符串
    Dim p As String     '正则表达式
    Dim r As String     '要替换的字符串

    '以下代码是替换邮箱地址
     
    s = "我的E-mail: Test@163.com 。欢迎致电!"
    p = "\w+[\w.]*@[\w.]+\.\w+"
    r = "E_Mail@sohu.net"
    s = StrReplace(s, p, r)
    Debug.Print s
    '结果:我的E-mail: E_Mail@sohu.net 。欢迎致电!

End Sub

Private Sub Command3_Click()

    Dim re As RegExp
    Dim mh As Match
    Dim mhs As MatchCollection
    Dim inpStr As String
   
    inpStr = "我的E-mail: lucky@163.com 。欢迎致电!"
    Set re = New RegExp
    re.Pattern = "(\w+)@(\w+).(\w+)"         '同样是匹配地址,注意和上例的不同
    Set mhs = re.Execute(inpStr)
    Set mh = mhs(0)                          '只有一个匹配
   
    Debug.Print "电子邮件地址是: " & mh.Value                '这里是匹配的内容
    Debug.Print "用户名是:             " & mh.SubMatches(0)  '第一个括号中的内容
    Debug.Print "邮箱是:                 " & mh.SubMatches(1)  '第二个括号中的内容
    Debug.Print "域名是:           " & mh.SubMatches(2)  '第三个括号中的内容
   
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2011-2-28 18:05 | 显示全部楼层

正是我要找的,多谢!!

正是我要找的,多谢!!我顶

TA的精华主题

TA的得分主题

发表于 2011-2-28 21:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
虽然WINLAND老师已经有类似的帖了,不过蛮基础的,谢谢楼主分享。

TA的精华主题

TA的得分主题

发表于 2011-2-28 23:35 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
谢谢楼主分享

TA的精华主题

TA的得分主题

发表于 2011-4-7 16:11 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

回复 1楼 wwwbjwww 的帖子

wwwbjwww 老师,有没有这方面的实例呢。搞不懂怎么使用。

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-4-7 16:30 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

回复 6楼 80177850 的帖子

请查阅我之前有发过正则式在重定向网页中的运用一贴,该贴的分析用到了正则表达式,但有一定的难度,你还是先把基础打牢再看好一些

TA的精华主题

TA的得分主题

发表于 2011-4-7 17:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
正是我要找的,多谢!!
正是我要找的,多谢!!我顶

TA的精华主题

TA的得分主题

发表于 2011-5-6 22:38 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2011-7-9 15:52 | 显示全部楼层
LZ好,请问

<table cellspacing="0" cellpadding="0"><tr><td class="t_msgfont" id="postmessage_45174056">编号301<br />
绝杀一红=[15]<br />
绝杀一蓝=[10]<br />
精杀五红=[26 27 28 29 30]</td></tr></table>


怎么提取 如下呢
编号301
绝杀一红=[15]
绝杀一蓝=[10]
精杀五红=[26 27 28 29 30]

最大的困扰是 cellspacing="0" cellpadding="0"><tr><td class="t_msgfont" id="postmessage_45174056">
数据不固定呀  不好搞

TA的精华主题

TA的得分主题

发表于 2011-12-14 21:00 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-23 18:46 , Processed in 0.036333 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表