Раскрась каждое слово в ячейке с помощью поля ввода и нескольких слов одновременно

Question

У меня есть почти такой же макрос из другой темы Здесь. И теперь я пытаюсь добавить Inputbox, где я могу написать то же, что и в коде в Mylist, без необходимости писать каждое слово в коде. Но я обнаружил, что трудно заключить в кавычки каждое слово для ввода цветных слов. Я могу раскрасить только одно слово, и я застрял, как процитировать каждое слово в поле ввода отдельно.

Вот мой отредактированный код из оригинальной темы:

Option Explicit
Option Compare Text

Sub test()
    Dim myList, myColor, myPtn As String, r As Range, m As Object, msg As String, x
'    Application.Selection.Font.ColorIndex = xlAutomatic
    msg = Application.InputBox("Choose keywords to highlight (max 6) that are separated with commas and space", "Input keywords", , , , , , 2)
    myList = VBA.Array(msg)  '<-- add more if needed
    myColor = VBA.Array(vbRed, vbBlue, vbYellow, vbCyan, vbGreen, vbMagenta) '<-- adjust as per myList(use Color value, not ColorIndex)
    myPtn = Join$(myList, Chr(2))
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        .Pattern = "([\^\$\(\)\[\]\*\+\-\?\.\|])"
        myPtn = Replace(.Replace(myPtn, "\$1"), Chr(2), "|")
        .Pattern = "\b(" & myPtn & ")\b"
        For Each r In Application.Selection
            If .test(r.Value) Then
                For Each m In .Execute(r.Value)
                    x = Application.Match(m, myList)
                    If Not IsError(x) Then
                        r.Characters(m.firstindex + 1, m.Length).Font.Color = myColor(x - 1)
                    End If
                Next
            End If
        Next
    End With
End Sub

Answer 1

То, что вы пытаетесь достичь, это:

 myList = VBA.Array("word1", "word2")

Но проблема, с которой вы сталкиваетесь, заключается в том, что значение InputBox возвращается в виде одной строки. Результат:

msg = "word1, word2"
myList = VBA.Array("word1, word2")

Таким образом, вы будете искать только эту конкретную строку.

Самый простой способ обойти эту проблему, используя этот код, это использовать функцию Split .
Split (string, delimiter, limit, compare)

Split возьмет строку, разделит ее и вернет в виде массива, а это именно то, что вам нужно. Путем изменения

myList = VBA.Array(msg)

в

myList = Split(msg, ", ")

Слово предел

Если вы хотите ограничить количество ключевых слов, вы можете добавить проверку количества введенных ключевых слов, используя:

Application.CountA(myList)

И ограничить его « If Application.CountA(myList) > 6 Then "или подобное.

Выбор безопасности

Еще одна вещь, которую вы можете добавить, это ограничение количества выбранных ячеек для запуска кода.
Если пользователь решит "выбрать все" перед использованием этого, его Excel, скорее всего, выйдет из строя в течение нескольких часов, если не принудительно закроет программу. Просто:

If Application.Selection.Count > 1000 Then

Или аналогично, с последующим предупреждением или полной остановкой, возможно, было бы целесообразно.