Excel VBA função Planilha personalizada busca por duas palavras

Planilha Excel VBA teclas abrir teclado virtual vba macros

Excel VBA função Planilha personalizada busca por duas palavras

Este Macro e Função Personalizada do Aplicativo Microsoft Excel VBA(Visual Basic Application), busca duas palavras em células se existir retorna (verdadeiro) senão (Falso), observe que usei uma instrução For … next para chamar a função usando os argumentos corretos na linha de código evitando o uso de fórmulas, mas também tem a coluna com as fórmulas usando a função personalizada para ilustrar o exemplo. Chamar uma Função Via Macro, melhora muito a performance de sua planilha. Fique com Deus, Expedito Marcondes.

Sub sbx_localiza_palavras()
Dim i As Long
For i = 5 To Cells(Rows.Count, “c”).End(xlUp).Row
If PalavrasOk(Cells(i, “c”), “bela”, “bom”) Then
Cells(i, “f”).Value = “EXISTE-VERDADE”
Else
Cells(i, “h”).Value = “NÃO EXISTE-FALSO”
End If
Next i
End Sub
‘//==========’
Sub sbx_deleta_dados_teste()
Dim x As Long
x = Cells(Rows.Count, “c”).End(xlUp).Row
Range(Cells(5, “f”), Cells(x, “h”)).ClearContents
End Sub

‘//==========’
Function PalavrasOk(Palavra As String, M1 As String, M2 As String) As Boolean
Dim Sinais1 As String, Sinais2 As String, A As String, B As String
Application.Volatile
‘Sinais a ignorar !!!!!!!
Sinais2 = “[ ,;.:()!?]”

Sinais1 = “*” & Sinais2
Sinais2 = Sinais2 & “*”
Palavra = UCase(Palavra)
M1 = UCase(M1)
M2 = UCase(M2)
A = InStr(Palavra, M1)
B = InStr(Palavra, M2)

If A * B > 0 Then ‘Se exitir as 2 Palavras
If A > 1 Then
If B > 1 Then
If A < Len(Palavra) – Len(M1) + 1 Then
If B < Len(Palavra) – Len(M2) + 1 Then
If (Palavra Like (Sinais1 & M1 & Sinais2)) And (Palavra Like (Sinais1 & M2 & Sinais2)) Then PalavrasOk = True Else PalavrasOk = False
Else
If (Palavra Like (Sinais1 & M1 & Sinais2)) And (Palavra Like (Sinais1 & M2)) Then PalavrasOk = True Else PalavrasOk = False
End If
Else
If B < Len(Palavra) – Len(M2) + 1 Then
If (Palavra Like (Sinais1 & M1)) And (Palavra Like (Sinais1 & M2 & Sinais2)) Then PalavrasOk = True Else PalavrasOk = False
Else
If (Palavra Like (Sinais1 & M1)) And (Palavra Like (Sinais1 & M2)) Then PalavrasOk = True Else PalavrasOk = False
End If
End If
Else
If A < Len(Palavra) – Len(M1) + 1 Then
If (Palavra Like (Sinais1 & M1 & Sinais2)) And (Palavra Like (M2 & Sinais2)) Then PalavrasOk = True Else PalavrasOk = False
Else
If (Palavra Like (Sinais1 & M1)) And (Palavra Like (M2 & Sinais2)) Then PalavrasOk = True Else PalavrasOk = False
End If
End If
Else
If B > 1 Then
If B < Len(Palavra) – Len(M2) + 1 Then
If (Palavra Like (M1 & Sinais2)) And (Palavra Like (Sinais1 & M2 & Sinais2)) Then PalavrasOk = True Else PalavrasOk = False
Else
If (Palavra Like (M1 & Sinais2)) And (Palavra Like (Sinais1 & M2)) Then PalavrasOk = True Else PalavrasOk = False
End If
Else
If (Palavra Like (M1 & Sinais2)) And (Palavra Like (M2 & Sinais2)) Then PalavrasOk = True Else PalavrasOk = False
End If
End If
End If
End Function
‘//==========’
Sub visualizar_macro()
Dim resposta As String
resposta = MsgBox(“deseja visualizar(tela ou vbe)?” & vbCrLf & ” se SIM = Tela” & vbCrLf & ” se NAO = VBE”, vbYesNo, “Saberexcel – o site das macros”)
If resposta = 6 Then
ActiveSheet.Shapes.Range(Array(“macro”)).Select
Selection.Verb Verb:=xlPrimary
Else
Application.Goto reference:=”sbx_localiza_palavras”
End If
End Sub