使用正则表达式寻找字母和数字并进行替换

dogingate

Public Function strReplace(ByVal sText As String) As String
Dim reg
Dim zmMatches As String
Dim szMatches As String
Dim spansCount As Integer

spansCount = ActiveWorkbook.Worksheets("概况表").Cells(1, 2).Value

Set reg = CreateObject("vbscript.regexp")

'sText = Worksheets("汇总表").Range("a1").Value

With reg
    '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
    .Global = True

    '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
    .IgnoreCase = True

    .Pattern = "^[A-Za-z]+"
    '判断是否可以找到匹配的字符，若可以则返回True
    'MsgBox .test(sText)

    If .test(sText) Then
        '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
        Set objMatches = .Execute(sText)
        zmMatches = LCase(objMatches(0).Value) '编号从0开始
    End If

    '把字符串中用正则找到的所有匹配字符替换为其它字符
    'MsgBox .Replace(sText, "")
End With

With reg
    '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
    .Global = True

    '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
    .IgnoreCase = True

    .Pattern = "[0-9]+$"
    '判断是否可以找到匹配的字符，若可以则返回True
    'MsgBox .test(sText)

    If .test(sText) Then
        '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
        Set objMatches = .Execute(sText)
        szMatches = objMatches(0).Value '编号从0开始
    End If

    '把字符串中用正则找到的所有匹配字符替换为其它字符
    'MsgBox .Replace(sText, "")
End With

Select Case zmMatches
    Case "k"
        strReplace = "第" & CStr(szMatches) & "跨"
    Case "dt"
        If szMatches = 0 Then
            strReplace = CStr(szMatches) & "#桥台"
        ElseIf szMatches = spansCount Then
            strReplace = CStr(szMatches) & "#桥台"
        Else
            strReplace = CStr(szMatches) & "#桥墩"
        End If
    Case "z"
        strReplace = CStr(szMatches) & "#支座"
    Case "b"
        strReplace = CStr(szMatches) & "#主梁"
    Case Else
        strReplace = sText
End Select

'MsgBox strReplace

End Function

duquancai

谢谢分享：关键在写出正确高效的“表达式”，而正则对象的属性和方法显得不是那么重要！

dogingate

这个是帮助，用的时候翻翻，很方便

dogingate

这个是寻找字符串中数字的小函数，strText为包含数字的字符串
Function regFind(strText)
Set reg = CreateObject("vbscript.regexp")

With reg
    '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
    .Global = True

    '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
    .IgnoreCase = True

    .Pattern = "[0-9]+$"
    '判断是否可以找到匹配的字符，若可以则返回True
    'MsgBox .test(sText)

    If .test(strText) Then
        '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
        Set objMatches = .Execute(strText)
        regFind = objMatches(0).Value '编号从0开始
    End If

End With
End Function

jinhaitiao16

楼主，我的WPS版没有用呀！

sdg1345

dogingate 发表于 2018-11-28 10:40
这个是帮助，用的时候翻翻，很方便

mark 谢谢分享

dogingate

jinhaitiao16 发表于 2019-2-23 11:34
楼主，我的WPS版没有用呀！

这个是office的vba吧，wps版怎么能用呢

dogingate

这是网上找来的，可以测试vba语句的，enjoy

dogingate

最近整理了两个正则的子函数regTest用于测试正则表达式是否有效，regMatch则返回经过正则表达式提取的字符串
传入三个参数，strRegText,strPattern,oreg分别为欲进行正则提取的文本，正则表达式，正则表达式对象

Function regTest(ByVal strRegText As String, ByVal strPattern As String, ByVal oreg As Object) As Boolean
Dim strMatch As String

With oreg
    '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
    .Global = True
    '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
    .IgnoreCase = True
   
    .Pattern = strPattern
   
    If .test(strRegText) Then
        regTest = True
    Else
        regTest = False
    End If

End With

End Function

Function regMatch(ByVal strRegText As String, ByVal strPattern As String, ByVal oreg As Object)
'''属性 pattern global ignorecase multiline
'''方法 test replace execute
Dim strMatch As String

With oreg
    '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
    .Global = True
    '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
    .IgnoreCase = True
    '设置要查找的字符模式
    .Pattern = strPattern

    '判断是否可以找到匹配的字符，若可以则返回True
    'MsgBox .test(sText)

    '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
    Set objmatches = .Execute(strRegText)

    If objmatches.Count = 1 Then
       strMatch = objmatches(0)
    Else
        MsgBox "error"
    End If

    '把字符串中用正则找到的所有匹配字符替换为其它字符
    'MsgBox .Replace(sText, "")
End With

regMatch = strMatch

End Function

aguowork

学习了，留名，常回来看看