关于正则表达式的函数我写了很多VBA

Public Function CountRegx(text As String, patt As String) As Long
    On Error GoTo ErrorHandler
    Dim RE As New RegExp
    RE.Pattern = patt
    RE.Global = True
    RE.IgnoreCase = False
    RE.multiLine = True
    'Retrieve all matches
    Dim Matches As MatchCollection
    Set Matches = RE.Execute(text)
    'Return the corrected count of matches
    CountRegx = Matches.count
ErrorHandler:
    If Err.Number <> 0 Then
        MyMsgBox Err.Number & " " & Err.Description, 30
    End If
End Function

Public Function MatchRegx(text As String, patt As String, Optional ignoreC As Boolean = False) As Boolean
    If testing Then Exit Function
    'Set up regular expression object
    Dim RE As New RegExp
    RE.Pattern = patt
    RE.Global = True
    RE.IgnoreCase = ignoreC
    RE.multiLine = True
    'Retrieve all matches
    Dim Matches As MatchCollection
    Set Matches = RE.Execute(text)
    'Return the corrected count of matches
    If Matches.count > 0 Then
        MatchRegx = True
    Else
        MatchRegx = False
    End If
End Function

Public Function RplRegx(str As String, regxStr As String, regxStrRpl As String)
    If testing Then Exit Function
    Dim regEx As New RegExp

    With regEx
        .Global = True
        .multiLine = True
        .IgnoreCase = False
        .Pattern = regxStr
    End With

    While regEx.Test(str)
        str = regEx.Replace(str, regxStrRpl)
    Wend
    
    
    RplRegx = str
End Function

Public Function SearchRegxKwInStr(str As String, regxKw As String, Optional multiLine As Boolean = False, Optional ignoreC As Boolean = False)
    'SearchRegxKwInStr
    If testing Then Exit Function
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = ignoreC
        .multiLine = multiLine
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    Dim dynamicStr1 As String
    dynamicStr1 = ""
    Set mc = reg.Execute(str)
    If mc.count > 0 Then
        dynamicStr1 = mc.item(0).SubMatches.item(0)
    End If

    SearchRegxKwInStr = dynamicStr1
End Function

Public Function SearchRegxKwInFileMult(filePath As String, regxKw As String, matchI As Integer)
    If testing Then Exit Function
    Dim fso, FileIn, strTmp
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set FileIn = fso.OpenTextFile(filePath, 1) 'for reading only
    
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = False
        
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    Dim dynamicStr1 As String
    
    Do Until FileIn.AtEndOfStream
        strTmp = FileIn.readline
        If Len(strTmp) > 0 Then
            Set mc = reg.Execute(strTmp)
            If mc.count > 0 Then
                dynamicStr1 = mc.item(0).SubMatches.item(matchI)
                Exit Do
            End If
        End If
    Loop
    
    FileIn.Close
    Set fso = Nothing
    
    SearchRegxKwInFileMult = dynamicStr1
End Function

Public Function SearchRegxKwInFileMultToList(filePath As String, regxKw As String, matchI As Integer)
    If testing Then Exit Function
    Dim fso, FileIn, strTmp
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set FileIn = fso.OpenTextFile(filePath, 1) 'for reading only
    
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = False
        
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    'Dim dynamicStr1 As String
    Dim i As Integer
    Dim j As Integer
    i = 0
    
    Dim strArr() As String
    Dim tmpArr() As String
    
'    Dim fileStr As String
'    fileStr = FileIn.readall
'
'    Set mc = reg.Execute(fileStr)
'    If mc.count > 0 Then
'        ReDim strArr(mc.count) As String
'        For i = 0 To mc.count - 1
'            strArr(i) = mc.Item(i).SubMatches.Item(matchI)
'        Next
'    End If
    ReDim tmpArr(1) As String
    Do Until FileIn.AtEndOfStream
        strTmp = FileIn.readline
        'MsgBox strTmp
        If Len(strTmp) > 0 Then
            Set mc = reg.Execute(strTmp)
            If mc.count > 0 Then
                ReDim strArr(i + 1) As String
                For j = 0 To UBound(strArr) - 1
                    strArr(j) = tmpArr(j)
                Next
                strArr(i) = mc.item(0).SubMatches.item(matchI)
                tmpArr = strArr
                'Exit Do
                i = i + 1
            End If
        End If
    Loop
    
    FileIn.Close
    Set fso = Nothing
    SearchRegxKwInFileMultToList = strArr
End Function

Public Function SearchRegxKwInStrToList(str As String, regxKw As String, Optional ignoreC As Boolean = False)
    If testing Then Exit Function
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = ignoreC
        .multiLine = False
        '.multiLine = True
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    'Dim dynamicStr1 As String

    Set mc = reg.Execute(str)
    
    Dim i As Long
    If mc.count > 0 Then
        ReDim strArr(mc.count) As String
        For i = 0 To mc.count - 1
            strArr(i) = mc.item(i).SubMatches.item(0)
            'MsgBox mc.Item(i).SubMatches.Item(0)
        Next
    End If

    SearchRegxKwInStrToList = strArr
End Function

Public Function SearchRegxKwInStrMultToList(str As String, regxKw As String, matchI As Integer, multiFlag As Boolean)
    If testing Then Exit Function
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = False
        .multiLine = multiFlag
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    'Dim dynamicStr1 As String
    
    Set mc = reg.Execute(str)
    ReDim strArr(mc.count - 1) As String
        
    Dim i As Integer
    If mc.count > 0 Then
        For i = 0 To mc.count - 1
            strArr(i) = Replace(mc.item(i).SubMatches.item(matchI), ",", ";")
        Next
    End If

    SearchRegxKwInStrMultToList = strArr
End Function

Public Function SearchRegxKwInStrMult(str As String, regxKw As String, matchI As Integer)
    If testing Then Exit Function
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = False
        
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    Dim dynamicStr As String
    
    Set mc = reg.Execute(str)
    Dim i As Integer
    If mc.count > 0 Then
        dynamicStr = mc.item(0).SubMatches.item(matchI)
    End If

    SearchRegxKwInStrMult = dynamicStr
End Function

Public Function SearchRegxKwInFile(filePath As String, regxKw As String, Optional multiLine As Boolean = False, Optional ignoreC As Boolean = False)
    If testing Then Exit Function
    Dim fso, FileIn, strTmp
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set FileIn = fso.OpenTextFile(filePath, 1) 'for reading only
    
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = ignoreC
        .multiLine = multiLine
        .Pattern = regxKw
    End With
    
    Dim mc As MatchCollection
    Dim dynamicStr1 As String
    
    
    If multiLine Then
        Dim strAll As String
        strAll = FileIn.readall
        If dynamicStr1 = "" And multiLine Then
            Set mc = reg.Execute(strAll)
            If mc.count > 0 Then
                'MsgBox "hi"
                dynamicStr1 = mc.item(0).SubMatches.item(0)
            End If
        End If
    
    Else
        
        Do Until FileIn.AtEndOfStream
            strTmp = FileIn.readline
            If Len(strTmp) > 0 Then
                Set mc = reg.Execute(strTmp)
                If mc.count > 0 Then
                    dynamicStr1 = mc.item(0).SubMatches.item(0)
                    Exit Do
                End If
            End If
        Loop
    
    End If
    
    FileIn.Close
    Set fso = Nothing
    
    SearchRegxKwInFile = dynamicStr1
End Function
最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
  • 人面猴
    序言：七十年代末，一起剥皮案震惊了整个滨河市，随后出现的几起案子，更是在滨河造成了极大的恐慌，老刑警刘岩，带你破解...
    沈念sama阅读 205,033评论 6赞 478
  • 死咒
    序言：滨河连续发生了三起死亡事件，死亡现场离奇诡异，居然都是意外死亡，警方通过查阅死者的电脑和手机，发现死者居然都...
    沈念sama阅读 87,725评论 2赞 381
  • 救了他两次的神仙让他今天三更去死
    文/潘晓璐 我一进店门，熙熙楼的掌柜王于贵愁眉苦脸地迎上来，“玉大人，你说我怎么就摊上这事。” “怎么了？”我有些...
    开封第一讲书人阅读 151,473评论 0赞 338
  • 道士缉凶录：失踪的卖姜人
    文/不坏的土叔 我叫张陵，是天一观的道长。 经常有香客问我，道长，这世上最难降的妖魔是什么？ 我笑而不...
    开封第一讲书人阅读 54,846评论 1赞 277
  • 港岛之恋（遗憾婚礼）
    正文 为了忘掉前任，我火速办了婚礼，结果婚礼上，老公的妹妹穿的比我还像新娘。我一直安慰自己，他们只是感情好，可当我...
    茶点故事阅读 63,848评论 5赞 368
  • 恶毒庶女顶嫁案：这布局不是一般人想出来的
    文/花漫 我一把揭开白布。 她就那样静静地躺着，像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上，一...
    开封第一讲书人阅读 48,691评论 1赞 282
  • 城市分裂传说
    那天，我揣着相机与录音，去河边找鬼。 笑死，一个胖子当着我的面吹牛，可吹牛的内容都是我干的。 我是一名探鬼主播，决...
    沈念sama阅读 38,053评论 3赞 399
  • 双鸳鸯连环套：你想象不到人心有多黑
    文/苍兰香墨 我猛地睁开眼，长吁一口气：“原来是场噩梦啊……” “哼！你这毒妇竟也来了？” 一声冷哼从身侧响起，我...
    开封第一讲书人阅读 36,700评论 0赞 258
  • 万荣杀人案实录
    序言：老挝万荣一对情侣失踪，失踪者是张志新（化名）和其女友刘颖，没想到半个月后，有当地人在树林里发现了一具尸体，经...
    沈念sama阅读 42,856评论 1赞 300
  • 护林员之死
    正文 独居荒郊野岭守林人离奇死亡，尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,676评论 2赞 323
  • 白月光启示录
    正文 我和宋清朗相恋三年，在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,787评论 1赞 333
  • 活死人
    序言：一个原本活蹦乱跳的男人离奇死亡，死状恐怖，灵堂内的尸体忽然破棺而出，到底是诈尸还是另有隐情，我是刑警宁泽，带...
    沈念sama阅读 33,430评论 4赞 321
  • 日本核电站爆炸内幕
    正文 年R本政府宣布，位于F岛的核电站，受9级特大地震影响，放射性物质发生泄漏。R本人自食恶果不足惜，却给世界环境...
    茶点故事阅读 39,034评论 3赞 307
  • 男人毒药：我在死后第九天来索命
    文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹，春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,990评论 0赞 19
  • 一桩弑父案，背后竟有这般阴谋
    文/苍兰香墨 我抬头看了看天上的太阳。三九已至，却和暖如春，着一层夹袄步出监牢的瞬间，已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,218评论 1赞 260
  • 情欲美人皮
    我被黑心中介骗来泰国打工， 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留，地道东北人。 一个月前我还...
    沈念sama阅读 45,174评论 2赞 352
  • 代替公主和亲
    正文 我出身青楼，却偏偏与公主长得像，于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子，可洞房花烛夜当晚...
    茶点故事阅读 42,526评论 2赞 343