全民一起VBA实战篇第四课：文本内容的处理技巧

题目一

按照要求设置输出格式

Option Explicit
Sub 单位()
    Dim i, s
    i = 1222.222223
    s = Format(i, "$.###")
    '#代表一位数字
    MsgBox s    
End Sub

Option Explicit
Sub 单位()
    Dim i, s
    i = 1222.2
    s = Format(i, "$.0000")
    '0代表一位数字,不足的位数用0代替
    '如果格式为00.0000
    '结果为1222.2000而不是22.2000
   	'#同理
    MsgBox s   
End Sub

正数，负数，零，空分别表示

Sub 格式2()    
    Dim i, s
    For i = 2 To 5
        s = Format(Cells(i, 2), "$.000;($.000);零;-")
        '第一个管正数，第二个负数，第三个0，第四个管空
        '分号隔开，中间不再添加引号
        Cells(i, 3) = s
    Next i    
End Sub

针对日期的格式

Sub 日期格式()
    Dim s As String, d As Date
    d = Range("b2").Value
    s = Format(d, "m月第d天(公元yyyy年),dddd")
 	Cells(3, 2) = s    
End Sub

题目二

多重循环+正则表达式破复杂结构

简单复习一下正则表达式

Sub 正则表达式1()
    Dim i As Long, s As String, myreg As Object
    Dim mymatches As Object, mymatch As Object   
    s = Range("B2").Value
    Set myreg = CreateObject("vbscript.regexp")
    '引入正则表达式功能
    myreg.Global = True
    '引入正则表达式代码
    myreg.Pattern = "(\d+)-(\d+)"
    '若干数字-若干数字
    Set mymatches = myreg.Execute(s)    
    i = 8    
    For Each mymatch In mymatches
    '循环扫描两捕获组
        Cells(i, 2) = mymatch.submatches(0)
        Cells(i, 3) = mymatch.submatches(1)
        i = i + 1
    Next mymatch       
End Sub

题目升级
张三电话 0411-82373923-2-1 李四电话 0571-233256343-1-1-1 王五电话 021-62344356-1

匹配出来

Sub 正则表达式2()
    Dim i, j As Long, s As String
    Dim mymatches1 As Object, myreg1 As Object
    Dim mymatches2 As Object, myreg2 As Object
    s = Range("B3").Value
    '第一个正则表达式，查找完整电话号码
    Set myreg1 = CreateObject("vbscript.regexp")
    myreg1.Global = True
    myreg1.Pattern = "\d+(-\d+)+"    
    '第二个正则表达式，在一个号码中查找连续数字
    Set myreg2 = CreateObject("vbscript.regexp")
    myreg2.Global = True
    myreg2.Pattern = "\d+"
    '执行第一个正则表达式
    Set mymatches1 = myreg1.Execute(s)
    '循环读取，并交给第二个来处理
    For i = 0 To mymatches1.Count - 1
    '对找到的号码执行第二个表达式
        Set mymatches2 = myreg2.Execute(mymatches1(i).Value)
        '循环读取没哥哥连续数字
        For j = 0 To mymatches2.Count - 1
            Cells(i + 7, j + 2) = mymatches2(j).Value
        Next j                
    Next i      
End Sub

非捕获组：
排除没有意义的捕获组，只分组，不捕获
(内容)改为(?:内容)
只保留了首尾

题目三

题目要求：解决以下文字的分解，找到各个站点名
北京西北京站北京东北京南站北京东

这个要求用到环视

名称	语法	含义
肯定顺序环视	(?=abc)	右边是abc
否定顺序环视	(?!abc)	右边不是abc
肯定逆序环视	(?<=abc)	左边是abc
否定逆序环视	(?<!abc)	左边不是abc

VBA只支持顺序环视

Sub 环视()
    Dim i, j As Long, s As String
    Dim mymatches As Object, myreg As Object
    s = Range("B3").Value
    '第一个正则表达式，查找完整电话号码
    Set myreg = CreateObject("vbscript.regexp")
    myreg.Global = True
    myreg.Pattern = "北京\S+?(?=北京|$)"
    '北京，任意非空字符，右边是北京，或者是结尾
    Set mymatches = myreg.Execute(s)
    For i = 0 To mymatches.Count - 1
        Cells(i + 1, 3) = mymatches(i).Value
    Next i
End Sub

对于这道题还可以多解

Sub 环视()
    Dim i As Long
    Dim a() As String, s
    a = Split(Range("b3").Value, "北京")
    '将字符串以"北京"为分隔符分开,返回的a是一个一维数组
    i = 2
    For Each s In a
        If s <> "" Then
            Cells(i, 1) = "北京" & s
            '拆分出来再进行拼接
            i = i + 1
        End If
    Next s    
End Sub

当然这道题可以用北京来拼接，一般情况下还是选择look around

题目四

原始金额 5321200213元 4230元 50220元
每4位中间加一个,分割
(?<=\d)(?=(\d{4})+元)
左边是一位数字，右边是4位数字，再加个元

这里用的是替换了，替换即在两个捕获组中间添加了逗号
但是由于VBA不支持逆序环视，所以代码还要修改

匹配目标
一个数字及其后面的位置该位置的特点为右侧有4n个数字并以元结束
替换过程
将上述匹配到的数字与位置，替换为该数字(即第一个捕获组中的内容，$1),以及一个逗号

Option Explicit
Sub Demo()
    Dim reg As Object, i As Long, s As String    
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = "(\d)(?=(\d{4})+元)"    
    '执行正则表达式，并将匹配出的结果依次写在A列各行
    For i = 3 To 7
        s = Cells(i, 2)
        Cells(i, 3) = reg.Replace(s, "$1,")
    Next i
End Sub

题目五

文本抓取所要注意的一些

<a href=[\s\S]*?>([\s\S]*?)</a>

[\s\S]包括一个字符，包括所有字符，也包括换行符
如果写.*，处理不了换行，只能处理一行，这里一定要用懒惰搜索
也可以写为

<a href=[^>]*>([\s\S]*?)</a>

一直搜索，直到遇到>

1. 找到唯一标识
2. 简化无关字符:警惕贪婪搜索和换行问题
3. 看情况设计多层正则表达式