☰

VBA 宏使用正则表达式强制单元格中的特定输入

tag-icon • tag-icon microsoft-excel vba regex
VBA 宏使用正则表达式强制单元格中的特定输入

当用户尝试在单元格中输入某些字符串时，我需要限制该输入，将其限制在以下列表中： C1、C2、C3、C4、C5、C6、C7、C8、C9、C10; 字： 合并、完成框架、宽度、左边框、右边框以及来自的整数1 至 100例如：
C6 合并 1，C4 合并 1。除这些之外不允许使用其他值。

我仍然无法找到必须使用哪个确切的正则表达式来包含上述所有规则。这是我的代码：

Private Sub Worksheet_Change(ByVal Target As Range)


Dim strPattern As String
Dim regEx As RegExp
Dim vValues As Variant
Dim vValue As Variant
Dim strInput As String
Dim currCell As Range
Dim MyRange As Range

Set MyRange = ThisWorkbook.Worksheets("BY Blocks").Range("G3:G308")
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
    strPattern = "the needed regex"
     'strPattern = "\b(C(?:10|[1-9])),(merge|complete framed|width),(\d+)"

    Set regEx = New RegExp

    vValues = Split(Target, ",")

    With regEx
     'For Each currCell In MyRange
           'If strPattern <> vbNullString Then
       ' strInput = currCell.Value
        'End If
              'Next currCell
        For Each vValue In vValues
            .Global = True
            .IgnoreCase = False
            .Pattern = strPattern

            If .Test(Trim(vValue)) Then
                MsgBox "Match found in " & Target.Value & " : " & Trim(vValue)
            Else
                MsgBox "No match"
            End If
     If (regEx.Execute(strInput)) Then
     '"smth when the pattern is matched"
     End If

     End With
     Set regEx = Nothing
     End If
      End Sub

实际上字符串模式是错误的，因为它在 If .Test(Trim(vValue)) 条件中找不到匹配项

答案1

这是一种不使用的方法正则表达式。

在标准模块中输入此UDF（）

Public Function IsItGood(aWord As Variant) As Boolean
    Dim s As String
    s = "|"
    tmp = s & aWord & s
    patern = ""

    For i = 1 To 100
        patern = patern & s & i
    Next i
    For i = 1 To 10
        patern = patern & s & "C" & i
    Next i
    patern = patern & s & "merge|complete framed|width|border left|border right" & s

    If InStr(1, patern, tmp) > 0 Then
        IsItGood = True
    Else
        IsItGood = False
    End If

End Function

在工作表代码区域输入： Private Sub Worksheet_Change(ByVal Target As Range) Dim BigS As String If Intersect(Range("G:G"), Target) Is Nothing Then Exit Sub arr = Split(Target, " ") For Each a In arr If IsItGood(a) Then Else MsgBox Target.Address(0, 0) & vbCrLf & a & vbCrLf & "has bad stuff" Application.Undo End If Next a End Sub

事件代码从列中获取短语输入G. 它将短语解析为单词，并确保每个单词都是预定义列表的成员。

编辑＃1：

先前版本的事件代码允许过多的UnDos。请改用此版本：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BigS As String

    If Intersect(Range("G:G"), Target) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    arr = Split(Target, " ")
    For Each a In arr
        If IsItGood(a) Then
        Else
            MsgBox Target.Address(0, 0) & vbCrLf & a & vbCrLf & "has bad stuff"
            Application.EnableEvents = False
                Application.Undo
            Application.EnableEvents = True
            Exit Sub
        End If
    Next a
End Sub
  1. 它只会验证单个单元格是否发生改变
  2. 它可以更好地处理细胞清除
  3. 它限制了错误消息的数量
  4. 它消除了由撤消引起的无限循环

相关内容