使用正则表达式强制执行单元格验证？

Question

使用Excel 2010.我想只允许单元格中符合给定正则表达式模式的值。所以我创建了一个UDF模块如下：

Public re as RegExp

Public Function isValidRegex(rng As Range, pattern As String) As Boolean

If re Is Nothing Then
    Set re = New RegExp
End If

re.pattern = pattern

isValidRegex = re.Test(rng.value)

End Function

我创建了一个名为THIS_CELL的命名区域，以便可以将当前单元格传递给isValidRegex()，如下所示：

=INDIRECT(ADDRESS(ROW(),COLUMN()))

我使用以下公式为单元格设置了自定义验证：

=isValidRegex(THIS_CELL,"(my|regex)patt[ern]")

这会产生以下错误：

A named range you specified cannot be found.

根据this article，UDF不能用于自定义验证公式。文章中建议的解决方案（将公式放在另一个单元格中，将该单元格放入命名范围，并在Custom公式中引用该单元格）不起作用，因为我需要能够将THIS_CELL作为参数传递这个功能。

我还尝试创建一个名为 isValidRegexPattern 的命名范围，将其定义为=isValidRegex(THIS_CELL,"(my|regex)patt[ern]")，并将自定义公式设置为=isValidRegexPattern，但这不起作用;在isValidRegex()中设置一个断点表明该函数甚至没有被调用。

那么，我如何使用UDF进行细胞验证呢？

Answer 1

您可以使用static变量和Worksheet_Change事件来保存先前值的快照

下面的代码跟踪A1:A10中的值，并使用与您类似的Regexp拒绝任何非数字条目

下面的示例尝试顶部复制并粘贴B1:B10而不是A1:A10，只允许A6和A8，因为它们是数字

设置范围最初更改感兴趣范围之外的单元格以触发If IsEmpty(X) Then X = [a1:a10].Value2

更改活动

Private Sub Worksheet_Change(ByVal Target As Range)

Static X As Variant
Dim rng2 As Range
Dim rng3 As Range

If IsEmpty(X) Then X = [a1:a10].Value2

Set rng2 = Intersect([a1:a10], Target)
If rng2 Is Nothing Then Exit Sub

Application.EnableEvents = False
For Each rng3 In rng2
    If Not isValidRegex(rng3, "\d+") Then rng3.Value = X(rng3.Row, 1)
Next
Application.EnableEvents = True

X = [a1:a10].Value2

End Sub

的regexp

Function isValidRegex(rng As Range, pattern As String) As Boolean
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.pattern = pattern
isValidRegex = re.Test(rng.Value)
End Function

Answer 2

您似乎不愿意转移到WorksheetChange事件宏，因为您认为它不会捕获单元格的更改前状态＆＃39; 。这在最严格的定义中可能是正确的，但这并不意味着您无法捕获已更改的状态，撤消更改，确定更改是否有效，并且只有在满足条件时才重新应用更改。

我不打算生成完整的正则表达式验证功能。这只是测试输入E列的数字是否小于零或空白。如果没有，那么单元格将恢复到其预交换状态。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns(5)) Is Nothing Then
        If Not IsEmpty(Target) Then
            On Error GoTo Safe_Exit
            Application.EnableEvents = False
            Dim vNEW As Variant
            vNEW = Target.Value
            Application.Undo
            If bIs_It_Valid(vNEW) Then
                Target = vNEW
            Else
                ' put stuff like idiot warnings here
            End If
        End If
    End If
Safe_Exit:
    Application.EnableEvents = True
End Sub

Private Function bIs_It_Valid(val As Variant) As Boolean
    If IsNumeric(val) Then _
        bIs_It_Valid = CBool(val < 0)
    Debug.Print bIs_It_Valid
End Function

如果粘贴多个值很重要，Worksheet_Change可能会被调整为适用于一系列单元格。

Answer 3

这是我不使用Worksheet_Change事件的方式

在新模块中定义公共REGEX函数

'Public REGEX Formula
Public Function REGEX(pattern As String, cel As Range) As Boolean
    Dim re As New RegExp
    re.pattern = pattern
    REGEX = re.Test(cel.Value)
End Function

我将此Sub添加到名为Validations的模块中。此Sub不仅需要验证范围和正则表达式模式，还需要另一个要应用REGEX公式的范围。应用的实际验证实际上仅检查该单独的单元格的True或False值。这是一个简化的版本，假定validationColumn是整个列。

'Validations Module
Sub regexValidation(cells As Range, pattern As String, validationColumn As Range, defaultValue As String)
    Dim cel As Range, regexFormula As String, validationCell As Range

    cells.Value = defaultValue

    'Need to match true on default value or validation will always fail
    pattern = "(" & defaultValue & ")|(" & pattern & ")"

    For Each cel In cells
        regexFormula = "=REGEX(""" & pattern & """," & cel.address & ")"
        Set validationCell = validationColumn.cells(cel.Row, 1)
        validationCell.Formula = regexFormula
        cel.Validation.Delete
        cel.Validation.Add xlValidateCustom, Formula1:="=" & Trim(validationCell.address)
    Next cel
End Sub

这就是我所说的。在我的情况下，这是一个UserForm，其中一个名为TextBox的{​​{1}}包含要应用的正则表达式。

regexPattern