Cor cada palavra na célula com inputbox e várias palavras de uma só vez

0

Eu tenho quase a mesma macro de outro segmento Aqui . E agora eu estou tentando adicionar Inputbox onde eu sou capaz de escrever o mesmo que estão no código em Mylist sem ter que escrever cada palavra no código. Mas eu encontrei as dificuldades para citar cada palavra na caixa de entrada para obter palavras coloridas. Eu posso colorir apenas uma palavra e estou preso como citar cada palavra na caixa de entrada separadamente.

Aqui está o meu código editado de um tópico original:

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, "\"), 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
    
por spriteup 08.12.2016 / 20:15

1 resposta

0

O que você está tentando alcançar é:

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

Mas o problema que você está enfrentando é porque o valor do InputBox é retornado como uma única string. O resultado é:

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

Então, você só pesquisará essa string específica.

A maneira mais fácil de contornar este problema usando este código é usando a função Split .
Split (string, delimiter, limit, compare)

O Split irá pegar uma string, dividi-la e retorná-la como uma matriz, que é exatamente o que você deseja. Alterando

myList = VBA.Array(msg)

para

myList = Split(msg, ", ")

Limite de palavras

Se você quiser limitar a quantidade de palavras-chave, adicione um cheque à quantidade de palavras-chave inseridas usando:

Application.CountA(myList)

E limite-o com um " If Application.CountA(myList) > 6 Then " ou similar.

Segurança de seleção

Outra coisa que você pode querer adicionar, é um limite na quantidade de células selecionadas para executar o código.
Se o usuário decidir "selecionar todos" antes de usá-lo, o Excel provavelmente ficará inoperante por horas, a menos que force o fechamento do programa. Um simples:

If Application.Selection.Count > 1000 Then

Ou semelhante, seguido por um aviso ou um ponto final, provavelmente seria sensato.

    
por 08.12.2016 / 22:48