Jak mogę porównać dwie kolumny w programie Excel, aby wyróżnić słowa, które nie pasują?

2

(Używam Microsoft Excel 2010)

Powiedzmy, że mam listę zwrotów zarówno w kolumnie A, jak i kolumnie B (patrz zrzut ekranu poniżej)

wprowadź opis zdjęcia tutaj

To, co chciałbym się wydarzyć, niezależnie od tego, czy będzie to makro, VBA czy formuła, to:

Jeśli w dowolnej komórce w kolumnie A znajduje się słowo, które nie jest żadnym słowem w żadnej komórce w kolumnie B, zaznacz to słowo na czerwono.

Na przykład: w komórce A9 jest słowo „kup”, ale słowo „kup” nie jest nigdzie wymienione w kolumnie B, więc chciałbym, aby słowo „kup” było podświetlone na czerwono.

Jak mogę to osiągnąć?

(Myślę, że makro / vba byłoby najlepszą opcją, ale nie mam pojęcia, jak go utworzyć, a nawet jeśli jest to możliwe).

Jez Vander Brown
źródło
1
Dobrze wytłumaczyłeś, co chcesz. Zredagowałem go trochę, aby dodać wyrazistości do tytułu i usunąć pozdrowienia (nieużywane tutaj). To, co poprawiłoby to pytanie, polegałoby na edycji pytania w celu uwzględnienia tego, co próbowałeś lub zbadałeś.
CharlieRB
1
Czy separator słowa jest zawsze pojedynczą spacją?
nixda

Odpowiedzi:

2

Wstaw następujący kod do modułu 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

Pamiętaj tylko, aby zmienić adresy w poniższych wierszach, aby pasowały do ​​arkusza.

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

Wyniki:

wprowadź opis zdjęcia tutaj

EDYTOWAĆ:

Ponieważ dodałeś wymagania w komentarzach poniżej, zmodyfikowałem kod, aby wydrukować również listę wyróżnionych na czerwono fraz w kolumnie C. Jeśli chcesz tę listę w innym miejscu, musisz dostosować adres w ostatniej sekcji kodu . Poprawiłem także kod podświetlania - zauważyłem, że robi dziwne rzeczy, takie jak tylko podkreślenie pierwszego wystąpienia niepasującego słowa.

Sub highlightWords()
Application.ScreenUpdating = False
Dim rng2HL As Range, rngCheck As Range, dictWords As Object, dictRed As Object
Dim a() As Variant, b() As Variant, wordlist As Variant, wordStart As Long, phraseLen As Integer
Dim re As Object, consec As Integer, tmpPhrase As String
'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
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

nowy przykład

Excellll
źródło
To jest perfekcyjne!! bardzo dziękuję za pomoc, nie sądziłem, że będzie to możliwe. Teraz, gdy wiem, że możesz pomóc trochę dalej i dołączyć do makra; Kiedy słowa zostaną podświetlone na czerwono, aby przenieść je do kolumny C jako listę? A jeśli mógłbyś pójść o krok dalej i dołączyć także, gdy lista znajduje się w kolumnie C, aby usunąć zduplikowane słowa?
Jez Vander Brown
Jeśli nie można tego uwzględnić w tym samym VBA, czy byłbyś w stanie stworzyć dla mnie osobny?
Jez Vander Brown
@JezVanderBrown OK, dodałem nowy kod do mojej odpowiedzi.
Excellll,
0

Jeśli umieścisz A i B na osobnych arkuszach, możesz użyć tekstu do kolumn, aby podzielić każdy element na wiele komórek, po jednym słowie na komórkę. Następnie prosta WYSZUKAJ () pozwoli ci znaleźć słowa, które nie pojawiają się w innym zestawie komórek.

Sparr
źródło