Макрос VBA Обеспечение определенного ввода в ячейку с помощью регулярного выражения

Question

Мне нужно ограничить пользователя, когда он пытается ввести некоторую строку в ячейку, этот ввод должен быть ограничен следующим списком: C1, C2, C3, C4, C5, C6, C7, C8, C9, C10 ; слова: слияние, полный кадр, ширина, левая граница, правая граница и целые числа от 1 до 100, например:
С6 объединить 1, С4 объединить 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.Условия тестирования (Trim (vValue))

Answer 1

Вот подход, который не использует Regex.

В стандартный модуль введите этот 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 в качестве диапазона) Dim BigS As String Если пересечение (диапазон («G:G»), Target) - ничто, то выход из Sub Subrr = Split (Target, "") для каждого a In Arr If IsItGood (a) Тогда Else MsgBox Target.Адрес (0, 0) & vbCrLf & a & vbCrLf & Приложение "содержит плохие вещи".Отменить конец, если следующий конец End Sub

Код события принимает ввод фразы из столбца G. Он разбирает фразу на слова и проверяет, что каждое слово является членом предварительно определенного списка.

EDIT # 1:

Предыдущая версия кода события допускала слишком много UnDo . Используйте эту версию вместо:

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. устраняет причину бесконечного цикла