Na minha resposta anterior, havia um erro que eu perdi. Nos raros casos, uma palavra foi seguida pela mesma letra que estava terminando, enquanto apenas aquela carta estava sendo procurada, então tanto a letra final como a letra seguinte eram coloridas.
Aqui está uma resposta atualizada:
Primeiro, escrevemos o sub e algumas variáveis que precisaremos:
Sub sameStringRed()
Dim i As Integer, j As Integer, intStart As Integer
Dim rngA As Range, rngB As Range
Dim strDelimit As String: strDelimit = " "
A variável strDelimit determina o que separa as palavras umas das outras e pode ser alterada para algo como "," se necessário.
Depois, definimos os intervalos conforme necessário.
For Each rngA In Selection.Rows
Set rngB = rngA.Offset(0, 1)
strA = Split(rngA.Text, strDelimit)
strB = Split(rngB.Text, strDelimit)
Next
Cada linha selecionada em uma coluna será rngA e cada linha na coluna próxima a ela será rngB .
Em seguida, uma matriz é criada com a função Split , com uma entrada para cada palavra em cada célula.
Em seguida, prosseguimos com a comparação dos dois arrays:
For j = LBound(strA) To UBound(strA)
For i = LBound(strB) To UBound(strB)
If UCase(strA(j)) = UCase(strB(i)) Then
intStart = InStr(1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
End If
Next i
Next j
Isso levará cada entrada em cada matriz e as comparará entre si.
E se forem idênticos, a variável intStart será configurada para a posição da primeira palavra correspondente na célula rngA da célula selecionada .
Agora com strDelimit adicionado em ambos os lados para garantir que não seja outra palavra que termine ou comece com a mesma coisa que está sendo pesquisada.
Agora, precisamos realmente fazer algo com essas informações, portanto, na declaração if anterior, podemos usar o seguinte:
While intStart > 0
rngA.Characters(Start:=intStart, Length:=Len(strB(i))).Font.ColorIndex = 3
intStart = InStr(intStart + 1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
Wend
Aqui, simplesmente definimos a cor dos caracteres na célula selecionada para indexar 3, que é vermelho.
Em seguida, adicionamos +1 ao intStart e executamos a verificação novamente para ver se temos mais palavras correspondentes.
Um pequeno problema agora é que
For Each rngA In Selection.Rows
Set rngB = rngA.Offset(0, 1)
exibirá um erro se várias colunas forem selecionadas.
Para lidar com isso, podemos adicionar um tratamento de erro simples com o uso de On Error GoTo Error
O código final será semelhante ao seguinte: Editar Ausência de maiúsculas e minúsculas e uma nova função de controle.
Sub sameStringRed()
Dim i As Integer, j As Integer, intStart As Integer
Dim rngA As Range, rngB As Range
Dim strDelimit As String: strDelimit = " "
For Each rngA In Selection.Rows
Set rngB = rngA.Offset(0, 1)
On Error GoTo Error
strA = Split(rngA.Text, strDelimit)
strB = Split(rngB.Text, strDelimit)
For j = LBound(strA) To UBound(strA)
For i = LBound(strB) To UBound(strB)
If UCase(strA(j)) = UCase(strB(i)) Then
intStart = InStr(1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
While intStart > 0
rngA.Characters(Start:=intStart, Length:=Len(strB(i))).Font.ColorIndex = 3
intStart = InStr(intStart + 1, strDelimit + UCase(rngA.Value) + strDelimit, strDelimit + UCase(strB(i)) + strDelimit)
Wend
End If
Next i
Next j
Next
Exit Sub
Error:
MsgBox "Please do not select multiple columns"
End Sub
E o resultado deve ficar assim:
