Excel·VBA自定义正则表达式函数、使用

发布日期:2024-10-14 09:58    点击次数:129
目录 正则表达式替换函数应用1,提取1个字母+10个数字应用2,中英文分割应用3,提取11位手机号应用4,指定文字替换应用5,提取最后一个括号的内容应用6,提取所有括号的内容应用7,提取地址中的省、市、县、乡应用8,仅保留数字和符号应用9,提取单价(整数、浮点数) 正则表达式获取函数应用1,提取品名、型号应用2,提取数字、运算符应用3,提取数字规格应用4,自动计算积分应用5,规格提取

正则表达式在线测试-菜鸟工具

正则表达式替换函数
Function RE(ByVal source_str$, pat$, Optional replace_str$ = "$1")
    '通用正则替换函数,函数定义RE(字符串,正则模式,替换值)对字符串返回正则替换后的字符串
    '可在表格中使用,仅适用单个单元格
    With CreateObject("vbscript.regexp")  '正则表达式
        .Global = True
        .Pattern = pat
        RE = .Replace(source_str, replace_str)
    End With
End Function
应用1,提取1个字母+10个数字

《excel吧提问-提取共同特征的数据》

正则:.*([a-zA-Z]\d{10}).*

图片

应用2,中英文分割

《excel吧提问-中英文分离》

正则:提取中文[a-zA-Z]*或[^一-龥]*或([a-zA-Z]+)
正则:提取英文[^a-zA-Z]*或[一-龥]*或.*?([a-zA-Z]+).*

图片

应用3,提取11位手机号

《excel吧提问-提取11位手机号》

正则:.*(\d{11}).*

图片

应用4,指定文字替换

《excel吧提问-将一列内容引入到另一列内容中间》

正则:([a-zA-Z]\d+)

图片

应用5,提取最后一个括号的内容

《excel吧提问-单元格字数不等,括号个数不等,怎么截取最后一个括号的内容》

正则:.*(?=\()

图片

应用6,提取所有括号的内容
正则:.*?(\(.*?\))

图片

应用7,提取地址中的省、市、县、乡

《wps吧提问-如何将省市县乡分列显示》

正则:(.*?(省|市|自治区))?(.*?(市|区|自治州|盟|地区))?(.*?(县|市|区|旗))?(.*?(乡|镇|街道))?(.*)

注意:直辖市地址应如下图所示写法

图片

参考资料: 《百度百科-地级行政区》 《百度百科-县级行政区》

应用8,仅保留数字和符号

《excel吧提问-如何去除单元格中的文字、字母,只保留数字和标点符号》

正则:[^\d-,]

注意:文中为中文逗号

图片

应用9,提取单价(整数、浮点数)

《excel吧提问-如何提取里面的单价》

正则:.*?(\d+(\.\d+)?)元.*

图片

正则表达式获取函数

2023.7.30更新,增加支持返回结果既能输出数组,又能输出数组的第n个值

Function RE_execute(ByVal source_str$, pat$, Optional n& = 0)
    '通用正则获取函数,函数定义RE_execute(字符串,正则模式,返回值)对单元格返回正则获取后的字符串数组
    '返回值n为0时返回数组结果,为其他整数时返回第n个值,正数顺序负数倒序(-1为最后一个)
    Dim result, i&, num&
    With CreateObject("vbscript.regexp")  '正则表达式
        .Global = True
        .Pattern = pat
        Set mhs = .Execute(source_str)
        num = mhs.Count
        If num = 0 Then RE_execute = "": Exit Function
        ReDim result(1 To num)
        For i = 0 To num - 1
            result(i + 1) = mhs(i).Value
        Next
        If n = 0 Then
            RE_execute = result
        ElseIf n > 0 And n <= num Then
            RE_execute = result(n)
        ElseIf n < 0 And Abs(n) <= num Then
            RE_execute = result(n + num + 1)
        Else
            RE_execute = ""
        End If
    End With
End Function
应用1,提取品名、型号

《excel吧提问-提取品名、型号》

Sub 品名型号()
    Dim s$, rng, r  '一定要定义类型,否则报错“ByRef参数类型不符”
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub  '仅支持单列,多列则退出
    For Each r In rng
        s = r.Value
        result = RE_execute(s, "[A-Za-z0-9/-]+")
        If IsArray(result) Then r.Offset(0, 2).Resize(1, UBound(result)) = result
    Next
End Sub

图片

应用2,提取数字、运算符

《excel吧提问-提取数字、运算符》 该正则匹配十分暴力,适用整数、小数的 A*B*C=D 形式

Sub 数字运算符()
    Dim s$, rng, r  '一定要定义类型,否则报错“ByRef参数类型不符”
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub  '仅支持单列,多列则退出
    For Each r In rng
        s = r.Value
        result = RE_execute(s, "\d+(\.\d+)?\*\d+(\.\d+)?\*\d+(\.\d+)?\=\d+(\.\d+)?")
        If IsArray(result) Then r.Offset(0, 2).Resize(1, UBound(result)) = result
    Next
End Sub

图片

应用3,提取数字规格

《excel吧提问-提取数字规格》

Sub 提取数字()
    Dim rng As Range, r, s$
    Set rng = [a2:a11]
    For Each r In rng
        s = r.Value
        result = RE_execute(s, "\d+(\.\d+)?(\-\d+)?")
        If IsArray(result) Then r.Offset(0, 1).Resize(1, UBound(result)) = result
    Next
End Sub

图片

应用4,自动计算积分

《excel吧提问-汇总积分》,提取+或者-之后的数字,对数字求和

Sub 自动计算积分()
    Dim rng As Range, r, arr, a
    Set rng = [a2:a5]
    For Each r In rng
        arr = RE_execute(r.Value, "[+-]\d+")
        a = Join(arr, "")
        r.Offset(0, 1) = Application.Evaluate(a)
    Next
End Sub

图片

应用5,规格提取 评论区提问,对2种规格分别提取,同时使用了RE函数和RE_execute函数
Sub 规格提取()
    Dim col, rng, r, s, result '一定要定义类型,否则报错“ByRef参数类型不符”
    col = 1    '需要处理的列号,字母"a"=数字1
    With ActiveSheet
        Set rng = Intersect(.UsedRange, .Cells(1, col).EntireColumn)  'intersect语句避免选择整列造成无用计算
        For Each r In rng
            If Len(r) Then
                result = RE_execute(r.Value, "\d+(\.\d+)?~\d+(\.\d+)?")
                r.Offset(1, 2).Resize(2, 1) = WorksheetFunction.Transpose(result)
                s = RE(r.Value, ".*?\*(\d+(\.\d+)?\*\d+(\.\d+)?)")
                r.Offset(1, 3).Resize(2, 1) = WorksheetFunction.Transpose(Split(s, "*"))
            End If
        Next
    End With
End Sub

图片

也可仅使用RE_execute函数提取规格,以下代码调用了《Excel·VBA单元格区域行列数转换函数》wraparr函数(如需使用代码需复制)
Sub 规格提取2()
    Dim col, rng, r, result   '一定要定义类型,否则报错“ByRef参数类型不符”
    col = 1    '需要处理的列号,字母"a"=数字1
    With ActiveSheet
        Set rng = Intersect(.UsedRange, .Cells(1, col).EntireColumn)  'intersect语句避免选择整列造成无用计算
        For Each r In rng
            If Len(r) Then
                result = RE_execute(r.Value, "\d+(\.\d+)?(~\d+(\.\d+)?)?")
                result = wraparr(WorksheetFunction.Transpose(result), "col", 2)
                r.Offset(1, 2).Resize(2, 2) = result
            End If
        Next
    End With
End Sub

图片

本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报。