Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")

Sub ValidatePattern()
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp") '創(chuàng)建正則表達(dá)式對(duì)象
    
    With re
        .Pattern = "^\d{4}-\d{2}-\d{2}$"
        .IgnoreCase = True '忽略大小寫
    End With

    Dim s As String
    s = "2025-12-31"

    If re.Test(s) Then
        Debug.Print s & " 格式正確"
    Else
        Debug.Print s & " 格式錯(cuò)誤"
    End If
End Sub

Sub ExtractMatches()
    Dim re As Object, matches As Object, m
    Dim text As String

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "\d+" '匹配一個(gè)或多個(gè)數(shù)字
    re.Global = True

    text = "訂單編號(hào): 12, 客戶編號(hào): 45, 數(shù)量: 67"

    Set matches = re.Execute(text)

    For Each m In matches '遍歷所有匹配項(xiàng)
        Debug.Print "匹配項(xiàng): " & m.Value
    Next
End Sub

Sub ReplaceText()
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    
    re.Pattern = "\bcat\b" '匹配獨(dú)立的單詞"cat"
    re.Global = True

    Dim s As String
    s = "cat dog catfish cat" '包含多個(gè)"cat", 只有獨(dú)立的"cat"會(huì)被替換

    Dim result As String
    result = re.Replace(s, "dog") '返回替換后的字符串

    Debug.Print result
End Sub

Sub Demo_MultiLine_False()
    Dim re As Object, mc As Object, m
    Set re = CreateObject("VBScript.RegExp")

    re.Pattern = "^ID:(\d+)"
    re.Global = True
    re.MultiLine = False   ' 默認(rèn)值

    Dim txt As String
    txt = "ID:1001 Name:Tom" & vbCrLf & _
          "ID:1002 Name:Jerry" & vbCrLf & _
          "ID:1003 Name:Alice"

    Set mc = re.Execute(txt)

    For Each m In mc
        Debug.Print m.SubMatches(0)
    Next
End Sub

Sub ExtractEmailsFromRange()
    Dim re As Object, mc As Object, m
    Dim r As Range, cell
    Set re = CreateObject("VBScript.RegExp")
    
    ' 匹配電子郵件地址的正則表達(dá)式
    re.Pattern = "\b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Za-z]{2,}\b"
    re.Global = True

    ' 遍歷選中的單元格，提取郵箱地址
    For Each cell In Selection
        If re.Test(cell.Value) Then
            Set mc = re.Execute(cell.Value)
            For Each m In mc
                Debug.Print "Found Email: " & m.Value
            Next
        End If
    Next
End Sub

Sub RemoveDuplicateWords()
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    
    ' 匹配重復(fù)單詞的正則表達(dá)式
    re.Pattern = "\b(\w+)\b\s+\b\1\b"
    re.Global = True

    Dim s As String
    s = "hello hello world world"
    
    ' 替換重復(fù)單詞為第一個(gè)單詞
    Debug.Print re.Replace(s, "$1")
End Sub