Como posso comparar duas colunas no Excel para destacar palavras que não correspondem?

Question

(estou usando o Microsoft excel 2010)

OK, digamos que eu tenha uma lista de frases na coluna A e na coluna B (veja a captura de tela abaixo)

Oqueeugostariadeacontecerfossecomumamacro,VBAoufórmulaé:

SehouverumapalavraemqualquercélulanacolunaAquenãosejanenhumadaspalavrasemqualquercélulanacolunaBpararealçaressapalavraemvermelho.

Porexemplo:nacélulaA9apalavra"buy" está lá, mas a palavra buy não é mencionada em nenhum lugar na coluna B, então eu gostaria que a palavra buy fosse destacada em vermelho.

Como posso conseguir isso?

(Eu acho que um macro / vba seria a melhor opção, mas eu não tenho ideia de como criá-lo, ou mesmo se é possível.)

    

Answer 1

Insira o seguinte código em um módulo VBA.

Sub highlightWords()
Application.ScreenUpdating = False
Dim rng2HL As Range, rngCheck As Range, dictWords As Object
Dim a() As Variant, b() As Variant, wordlist As Variant, wordStart As Long
Set r = Selection
'Change the addresses below to match your data.
Set rng2HL = Range("A1:A9")
Set rngCheck = Range("B1:B9")
a = rng2HL.Value
b = rngCheck.Value
Set dictWords = CreateObject("Scripting.Dictionary")
'Load unique words from second column into a dictionary for easy checking
For i = LBound(b, 1) To UBound(b, 1)
    wordlist = Split(b(i, 1), " ")
    For j = LBound(wordlist) To UBound(wordlist)
        If Not dictWords.Exists(wordlist(j)) Then
            dictWords.Add wordlist(j), wordlist(j)
        End If
    Next j
Next i
'Reset range to highlight to all black font.
rng2HL.Font.ColorIndex = 1
'Check words one by one against dictionary.
For i = LBound(a, 1) To UBound(a, 1)
    wordlist = Split(a(i, 1), " ")
    For j = LBound(wordlist) To UBound(wordlist)
        If Not dictWords.Exists(wordlist(j)) Then
            wordStart = InStr(a(i, 1), wordlist(j))
            'Change font color of word to red.
            rng2HL.Cells(i).Characters(wordStart, Len(wordlist(j))).Font.ColorIndex = 3
        End If
    Next j
Next i
Application.ScreenUpdating = True
End Sub

Apenas certifique-se de alterar os endereços nas linhas abaixo para corresponder à sua planilha.

Set rng2HL = Range("A1:A9")
Set rngCheck = Range("B1:B9")

Resultados:

EDITAR:

Desdequevocêadicionourequisitosnoscomentáriosabaixo,eumodifiqueiocódigoparatambémimprimiralistadefrasesdestacadasemvermelhonacolunaC.Sevocêquiseressalistaemoutrolugar,vocêteráqueajustaroendereçonaúltimaseçãodocódigo.Eutambémmelhoreiocódigodedestaque-noteiqueelefariacoisasestranhas,comodestacarapenasaprimeiraocorrênciadeumapalavranãocorrespondente.

SubhighlightWords()Application.ScreenUpdating=FalseDimrng2HLAsRange,rngCheckAsRange,dictWordsAsObject,dictRedAsObjectDima()AsVariant,b()AsVariant,wordlistAsVariant,wordStartAsLong,phraseLenAsIntegerDimreAsObject,consecAsInteger,tmpPhraseAsString'Changetheaddressesbelowtomatchyourdata.Setrng2HL=Range("A1:A9")
Set rngCheck = Range("B1:B9")
a = rng2HL.Value
b = rngCheck.Value
Set dictWords = CreateObject("Scripting.Dictionary")
'Load unique words from second column into a dictionary for easy checking
For i = LBound(b, 1) To UBound(b, 1)
    wordlist = Split(b(i, 1), " ")
    For j = LBound(wordlist) To UBound(wordlist)
        If Not dictWords.Exists(wordlist(j)) Then
            dictWords.Add wordlist(j), wordlist(j)
        End If
    Next j
Next i
Erase b
'Reset range to highlight to all black font.
rng2HL.Font.ColorIndex = 1
Set dictRed = CreateObject("Scripting.Dictionary")
Set re = CreateObject("vbscript.regexp")
'Check words one by one against dictionary.
For i = LBound(a, 1) To UBound(a, 1)
    wordlist = Split(a(i, 1), " ")
    consec = 0
    tmpPhrase = ""
    For j = LBound(wordlist) To UBound(wordlist)
        If Not dictWords.Exists(wordlist(j)) Then
            consec = consec + 1
            If consec > 1 Then tmpPhrase = tmpPhrase & " "
            tmpPhrase = tmpPhrase & wordlist(j)
        Else
            If consec > 0 Then
                If Not dictRed.Exists(tmpPhrase) Then dictRed.Add tmpPhrase, tmpPhrase
                re.Pattern = "(^| )" & tmpPhrase & "( |$)"
                Set matches = re.Execute(a(i, 1))
                For Each m In matches
                    wordStart = m.FirstIndex
                    phraseLen = m.Length
                    'Change font color of word to red.
                    rng2HL.Cells(i).Characters(wordStart + 1, phraseLen).Font.ColorIndex = 3
                Next m
                consec = 0
                tmpPhrase = ""
            End If
        End If
    Next j
    'Highlight any matches that appear at the end of the line
    If consec > 0 Then
        If Not dictRed.Exists(tmpPhrase) Then dictRed.Add tmpPhrase, tmpPhrase
        re.Pattern = "(^" & tmpPhrase & "| " & tmpPhrase & ")( |$)"
        Set matches = re.Execute(a(i, 1))
        For Each m In matches
            wordStart = m.FirstIndex
            phraseLen = m.Length
            'Change font color of word to red.
            rng2HL.Cells(i).Characters(wordStart + 1, phraseLen).Font.ColorIndex = 3
        Next m
    End If
Next i
Erase a
'Output list of unique red phrases to column C.
redkeys = dictRed.Keys
For k = LBound(redkeys) To UBound(redkeys)
    Range("C1").Offset(k, 0).Value = redkeys(k)
Next k
Erase redkeys
Application.ScreenUpdating = True
End Sub

    

Answer 2

Se você colocar A e B em folhas separadas, poderá usar Text to Columns para dividir cada item em várias células, uma palavra por célula. Em seguida, um simples LOOKUP () permite encontrar palavras que não aparecem no outro conjunto de células.