使用RegEx進行條件格式化的Excel VBA

Question

我有一個Excel 2010 VBA宏，它在電子表格的選定區域上執行一些條件格式化。 例如，以下代碼段搜索文本模式，然后為單元格着色：

Selection.FormatConditions.Add Type:=xlTextString, String:="TextToMatch", _
    TextOperator:=xlContains    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ColorIndex = 36
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False 

我想補充的是匹配正則表達式TN[0-9] 。 字符串TN后跟數字的簡單匹配。

我創建了RegExp對象：

Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
With regEx
        .Pattern = "TN[0-9]"
End With

但是我還沒想出如何將它應用於Selection 。

一如既往，感謝您的幫助。

Answer 1

我建議為VBScript.RegExp對象使用Static類型對象。

將傳遞給函數的范圍剪切到Worksheet.UsedRange屬性 。 這允許選擇完整列而不計算空行/列。

Option Explicit

Sub createCFR()
    With Selection
        'cut Selection down to the .UsedRange so that full row or full
        'column references do not use undue calculation
        With Intersect(.Cells, .Cells.Parent.UsedRange)
            .FormatConditions.Delete
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=myCFR(" & .Cells(1).Address(0, 0) & ")")
                .SetFirstPriority
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .ColorIndex = 36
                    .TintAndShade = 0
                End With
                .StopIfTrue = False
            End With
        End With
    End With
End Sub

Function myCFR(rng As Range)
    Static rgx As Object

    'with rgx as static, it only has to be created once
    'this is beneficial when filling a long column with this UDF
    If rgx Is Nothing Then
        Set rgx = CreateObject("VBScript.RegExp")
    End If

    'make sure rng is a single cell
    Set rng = rng.Cells(1, 1)

    With rgx
        .Global = True
        .MultiLine = True
        .Pattern = "TN[0-9]"
        myCFR = .Test(rng.Value2)
    End With
End Function

根據您的選擇 ，您可能需要修改用於創建CFR的Range.Address屬性的參數; 例如$A1將是.Address(1, 0) 。

在下圖中，B2：B7包含=myCFR(A2)填充以證明UDF。