VB6学习——正则的使用

1. 引用 Microsoft VBScrip Regular Expressions 5.5

Function FXMenu(txt As String, Optional isTip As Boolean = True)
1   On Error GoTo Err_FXMenu
    '-------------------------------------
    Dim RE As New RegExp
    Dim colMatches As MatchCollection
    Dim colMatches2 As MatchCollection
    Dim colMatches3 As MatchCollection
    Dim mm As Integer
    Dim menuTmp As String, FuMenu As String, whoUse As String

2   RE.Global = True


    '为空则退出
3   If Trim(txt) = "" Then
4       If isTip Then MsgBox "文本内容为空，分析终止！", vbOKOnly + vbInformation, "分析提示"
5       Exit Function
6   End If

7   txt = Replace(txt, vbCrLf, "")  '删除换行
8   Debug.Print txt

    '分析 子级 菜单
9   RE.Pattern = "Begin VB.Menu (\S+)\s*Caption         =   \""(\S+)\""\s*Index           =   (\d+)"

10  Set colMatches = RE.Execute(txt)
    'Debug.Print colMatches.Count
11  If colMatches.Count <= 0 Then Exit Function
12  Frm_FXConfig.Text_Menu.Text = "": Frm_FXConfig.Text_MenuCode.Text = ""
13  For mm = 0 To colMatches.Count - 1

14      If colMatches(mm).SubMatches(0) <> menuTmp Then    '换了一组菜单
            '查询 该组子菜单的 父菜单
15          RE.Pattern = "      Begin VB.Menu (\S+)\s*         Caption         =   \""\S+\""\s*Begin VB.Menu " & colMatches(mm).SubMatches(0)
16          Set colMatches2 = RE.Execute(txt)
17          FuMenu = "": whoUse = ""
18          If colMatches2.Count > 0 Then
19              FuMenu = colMatches2(0).SubMatches(0)  '子菜单的父菜单

                '根据 父菜单 找谁调用了这个 子菜单
20              RE.Pattern = "Private Sub (\S+)_[\S\s]{1,300}PopupMenu " & FuMenu
                Set colMatches3 = RE.Execute(txt)
22              If colMatches3.Count > 0 Then
23                  whoUse = colMatches3(0).SubMatches(0)
24              End If
25          End If
26          menuTmp = colMatches(mm).SubMatches(0)
27      End If


28      Frm_FXConfig.Text_Menu.Text = Frm_FXConfig.Text_Menu.Text + FuMenu & " --> " & whoUse & "    " & colMatches(mm).SubMatches(0) & " " & colMatches(mm).SubMatches(1) & " " & colMatches(mm).SubMatches(2) & vbCrLf



        '查找 哪个组件调用了这个 右键菜单
        '      Begin VB.Menu (\S+)\s*.*\s*Begin VB.Menu Mnu_PopHLBs
        'RE.Pattern = "Private Sub ([\S]+)_[\s\S]+PopupMenu " & D

        '自动生成代码



29  Next

VBA Excel 正则的使用

Option Explicit

Sub ExtractColorAndNumber()
    Dim i As Integer
    Dim lastRow As Long
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    'regex.Global = True
    
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 定义正则表达式
    Dim colorPattern As String
    colorPattern = ".{1,2}色"
    Dim numberPattern As String
    numberPattern = "\d+.?\d+#?(AWG)?"
    
    For i = 1 To lastRow
        ' 提取颜色
        Dim colorMatches As Object
        regex.Pattern = colorPattern
        Set colorMatches = regex.Execute(Cells(i, 2).Value)
        If colorMatches.Count > 0 Then
            Cells(i, 6).Value = Replace(colorMatches.Item(0), "-", "")
            Cells(i, 6).Value = Replace(Cells(i, 6).Value, "色", "")
        End If
        
        ' 提取数字
        Dim numberMatches As Object
        regex.Pattern = numberPattern
        Set numberMatches = regex.Execute(Cells(i, 2).Value)
        If numberMatches.Count > 0 Then
            Cells(i, 7).Value = numberMatches.Item(0)
        End If
    Next i
End Sub