Giriş kutusuyla hücrede bulunan her bir kelimeyi ve aynı anda birden fazla kelimeyi renklendirin

Burada diğer iş parçacığından neredeyse aynı makro var . Ve şimdi, her kelimeyi kodda yazmak zorunda kalmadan, Mylist'in kodundakiyle aynı olanları yazabileceğim Inputbox'ı eklemeye çalışıyorum. Ancak, renkli sözcükler almak için her bir kelimeyi giriş kutusundan alıntı yapmakta zorluk çektim. Sadece bir kelimeyi renklendirebilirim ve her bir kelimeyi giriş kutusuna ayrı ayrı nasıl alıntılayabileceğime şaşırdım.

İşte orjinal bir diziden gelen kodum:

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

Elde etmeye çalıştığın şey:

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

Ancak karşılaştığınız sorun, InputBox'un değerinin tek bir dize olarak döndürülmesidir. Sonuç:

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

Böylece sadece o dizgiyi arayacaksınız.

Bu kodu kullanarak bu sorunu çözmenin en kolay yolu, Splitişlevi kullanmaktır .
Split (string, delimiter, limit, compare)

Split, bir dize alır, böler ve tam olarak istediğiniz gibi bir dizi olarak döndürür. Değiştirerek

myList = VBA.Array(msg)

için

myList = Split(msg, ", ")

Kelime sınırı

Anahtar kelime miktarını sınırlamak istiyorsanız, aşağıdakileri kullanarak girilen anahtar kelime miktarını kontrol edebilirsiniz:

Application.CountA(myList)

Ve bir " If Application.CountA(myList) > 6 Then" veya benzeri bir şeyle sınırlandırın .

Seçim güvenliği

Eklemek isteyebileceğiniz başka bir şey de, kodu çalıştırmak için seçilen hücrelerin miktarındaki bir sınırdır.
Kullanıcı bunu kullanmadan önce "tümünü seçmeye" karar verirse, programı kapatmaya zorlamadıkça mükellefleri saatlerce hizmet dışı kalır. Basit:

If Application.Selection.Count > 1000 Then

Ya da benzer, ardından bir uyarı ya da tam durma izleyen muhtemelen akıllıca olacaktır.