使用输入框对单元格中的每个单词进行着色,并同时在其中添加多个单词

使用输入框对单元格中的每个单词进行着色,并同时在其中添加多个单词

我从其他线程中获得了几乎相同的宏这里。现在我试图添加输入框,这样我就可以在其中写入与 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

答案1

您想要实现的目标是:

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

但你面临的问题是由于输入框返回为单个字符串。结果是:

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

或者类似地,后面跟着一个警告或句号可能是明智的。

相关内容