文科生自学VBA-正则自定义函数小汇

--教育不是灌输，而是点燃火焰，学习编程成就更好的自己--

微软公司Office软件在商业办公领域一直占据着主流和主导地位，其中Excel在数据处理和分析领域有着强大的影响力，大部分人在经历几年职场历练后可以熟练的使用Excel函数和透视表功能，基本可以轻松完成绝大多数工作和任务。但实际上Office的强大和独特之处还在于VBA，因为VBA能够胜任好多个性化二次开发，减少重复机械劳动从而实现办公自动化，开发效率高且开发周期短，尤其对于Excel重度使用者来说会了VBA简直就是如虎添翼啊！！！(本人外语专业毕业，机缘巧合爱上编程，自学道路曲曲折折，痛并快乐！)在这里总结一下自学VBA遇到的难点和重点，分享码过的代码和要点总结，希望能够给初学者一点启示和鼓励，同时愿意结交更多大神交流有助提升自己的水平。

在VBA里可以编写符合自己需求的自定义函数(例如：个人所得税计算函数)，同时在VBA里也可以调用正则表达式处理文本数据，那么把这两者结合起来就能够制作强大的文本数据清洗工具了，今天简单列举一些常见的清洗和提取数据自定义函数，让大家感受和领略两者结合后的魅力和威力。

提取功能-抽取单元格内容中出现的第一个数字数据：

提取功能-抽取单元格内容中出现的第二个数字数据：

提取功能-抽取单元格内容中出现的第三个数字数据：

利用这几个正则自定义函数可以轻松得到想要的尺寸数据，可以直接算出体积或面积等数据，简直不要太方便了吧！！！

提取功能-抽取单元格内容中出现的第一个QQ号码数据：

可以看到QQ号码也轻松被提取出来，简单粗暴！！！

提取功能-抽取单元格内容中出现的第一个汉字信息数据：

提取功能-抽取单元格内容中出现的第二个汉字信息数据：

提取功能-抽取单元格内容中出现的第一个６位邮编信息数据：

提取功能-抽取单元格内容中出现的第一个英文信息数据：

替换功能-替换单元格内容中数字以外的字符或数据为空：

不仅可直接提取想的数据，也可以替换不想要的数据，是不是很爽！！

替换功能-替换单元格内容中汉字以外的字符或数据为空：

代码汇总如下：

Function PureNumberA(x) '提取出现的第一个纯数字数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "d+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
        PureNumberA = Val(.Execute(x)(0)) '把文本数据转换为数值数据，0代表第一个出现的值
    Else: PureNumberA = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function PureNumberB(x) '提取出现的第二个纯数字数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "d+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
        PureNumberB = Val(.Execute(x)(1)) '把文本数据转换为数值数据，1代表第二个出现的值
    Else: PureNumberB = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function PureNumberC(x) '提取出现的第三个纯数字数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "d+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
        PureNumberC = Val(.Execute(x)(2)) '把文本数据转换为数值数据，2代表第三个出现的值
    Else: PureNumberC = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function QQDTA(x) '提取出现的第一个QQ数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "QQd+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
        QQDTA = .Execute(x)(0)
    Else: QQDTA = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function ChineseA(x) '提取出现的第一个出现的汉字数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "[一-龥]+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
         ChineseA = .Execute(x)(0) '把文本数据转换为数值数据，0代表第一个出现的值
    Else:  ChineseA = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function ChineseB(x) '提取出现的第二个出现的汉字数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "[一-龥]+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
         ChineseB = .Execute(x)(1) '把文本数据转换为数值数据，1代表第二个出现的值
    Else:  ChineseB = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function PostNumberA(x) '提取出现的第一个6位邮编数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "d{6}"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
        PostNumberA = Val(.Execute(x)(0)) '把文本数据转换为数值数据，0代表第一个出现的值
    Else: PostNumberA = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function EnglishDTA(x) '提取出现的第一个英文数据
Application.ScreenUpdating = False
With CreateObject("VBSCRIPT.REGEXP")
    .Pattern = "[a-zA-Z]+"
    .IgnoreCase = True
    .Global = True
    If .Test(x) Then
        EnglishDTA = .Execute(x)(0)
    Else: EnglishDTA = ""
    End If
End With
Application.ScreenUpdating = True
End Function

Function OnlyNumber(x) '替换数字以外的字符为空
Application.ScreenUpdating = False
Set regex = CreateObject("VBSCRIPT.REGEXP")
    regex.Pattern = "[^d+]"
    regex.IgnoreCase = True
    regex.Global = True
OnlyNumber = regex.Replace(x, "")
Set regexex = Nothing
Application.ScreenUpdating = True
End Function

Function OnlyChinese(x) '替换汉字以外的字符为空
Application.ScreenUpdating = False
Set regex = CreateObject("VBSCRIPT.REGEXP")
    regex.Pattern = "[^一-龥]"
    regex.IgnoreCase = True
    regex.Global = True
OnlyChinese = regex.Replace(x, "")
Set regexex = Nothing
Application.ScreenUpdating = True
End Function

看到这是不是已经感受到正则和自定义函数结合的好处和威力？还不赶紧动手也试一试哇，如果想要做得更好就沉下心来学习一下正则表达式吧。

END

我为人人，人人为我！！欢迎大家关注，点赞和转发！！！

~~人生不是赛场，梦想不容退场~~不断努力学习蜕变出一个更好的自己，不断分享学习路上的收获和感悟帮助他人成就自己！！！