使用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 property。这允许选择完整列而不计算空行/列。

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

根据您的Selection，您可能需要修改用于创建CFR的Range.Address property的参数;例如$A1将是.Address(1, 0)。

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