Excel VBA - validação de duas ocorrencias juntas para remoção

isabela queiroz · 23 de agosto de 2022

preciso fazer um vba para uma planilha com umas descriçoes que tem informações como "CONTAINER FOR IMAGE <COMMERCIAL_SOFTWARE_7.4.1>"

porém o aplicativo da minha empresa não reconhece os dados se estiverem com "< >", a ideia é fazer um VBA que resolve o problema removendo esses caracteres, apenas quando aparecerem juntos na celula, se houver a ocorrencia de somente um não precisa remover, segue como pretendo fazer, porém sou iniciante em vba e não sei como fazer o codigo.

eu pensei numa lógica assim: identificar se existe o caractere < na descrição, se existir, identificar a posição do caractere
identificar se existe o caractere > na descrição, se existir, identificar a posição do caractere
depois validar se os 2 ocorrem ao mesmo tempo, se sim, removê-los se não ocorrem ao mesmo tempo não faz nada e começa a analisar a próxima descrição

uma variavel para guardar o dado encontrado, mas faria por comparação. Tipo o caractere analisado é iguarl a <? e depois uma outra para fazer a verificação para o >. tendo os dois retornos positivos, eu faria a troca deles, usando a referencia (posição).

Ou quem sabe duas variaveis mas apenas retornando a posição deles na frase, se as duas forem maior que zero, faz a troca também..

as informações estão na coluna "M" no "sheet2"

exemplo de um codigo que comecei mas não sei pra onde ir depois disso pra fazer ele reconhecer os dois ocrrendo junto, fora que ta apresentando problemas e entrando em loop depois de encontrar as ocorrencias na celula

Sub TESTANDDOWHILE()

'---------------tudo funciona------------------------

Dim pesquisa                As String
Dim pesquisadois            As String
Dim texto                   As Variant
Dim ultcell                 As Range
Dim c                       As Range
Dim firstAddress            As String
Dim i                       As Integer
Dim w                       As Worksheet 'dando nome a planilha
Dim vRNG                    As Range 'toda faixa de celula da planilha utilizada


pesquisa = "<"
pesquisadois = ">"

texto = ActiveCell.Text

Set w = Sheet2 'dando nome a planilha
Set ultcell = Sheet2.Range("M100000").End(xlUp)


w.Select 'selecionando
w.Range("M2").Select 'selecionando a coluna M



Dim Count As Integer
Dim Celll As Object
Dim N As Integer



Do While ActiveCell.Row <= ultcell.Row

    If Count = 0 Then
        If pesquisa = "" Then GoTo Done
            For Each Celll In Selection
                N = InStr(Celll.Value, pesquisa)
                While N <> 0
                    Count = Count + 1
                    N = InStr(N + 1, Celll.Value, pesquisa)
                Wend
             Next Celll
      


    If Count = 0 Then
        If pesquisadois = "" Then GoTo Done
            For Each Celll In Selection
                N = InStr(Celll.Value, pesquisadois)
                While N <> 0
                    Count = Count + 1
                    N = InStr(N + 1, Celll.Value, pesquisadois)
                Wend
            Next Celll
   
   
   MsgBox Count1 & Count2 & " Occurrences of " & pesquisa & pesquisadois 'conferindo se achou
Done:   
          
            ActiveCell.Offset(1, 0).Select
               texto = ActiveCell.Text


End If
End If

Loop

End Sub

Midori · 23 de agosto de 2022

@isabela queiroz Veja se assim resolve. Onde tem [A1] troque pela célula que deve ser verificada e se quiser colocar em um loop é só passar o argumento (Celll) para a sub,

Sub RemoveCaracteres(Celula As Range)
    If InStr(Celula, "<") And InStr(Celula, ">") Then
        Call Celula.Replace("<", "")
        Call Celula.Replace(">", "")
    End If
End Sub

Sub Macro()
    Call RemoveCaracteres([A1])
End Sub

isabela queiroz · 23 de agosto de 2022

@Midori

não to sabendo arrumar, ta aqui o codigo inteiro, ele ta ficando em um loop esquisito dentro do "do while"

basicamente ele faz:

Do While ActiveCell.Row <= ultcell.Row

If Count = 0 Then

End If

Loop

ta grifado aqui em baixo os locais que ta travando

Sub TESTANDDOWHILE()

'---------------tudo funciona------------------------

Dim pesquisa As String
Dim pesquisadois As String
Dim texto As Variant
Dim ultcell As Range
Dim c As Range
Dim firstAddress As String
Dim i As Integer
Dim w As Worksheet 'dando nome a planilha
Dim vRNG As Range 'toda faixa de celula da planilha utilizada

pesquisa = "<"
pesquisadois = ">"

texto = ActiveCell.Text

Set w = Sheet2 'dando nome a planilha
Set ultcell = Sheet2.Range("M100000").End(xlUp)

w.Select 'selecionando
w.Range("M2").Select 'selecionando a coluna M

'------------escolhendo o <--------------------------------------------------------

Dim Count As Integer
Dim Celll As Object
Dim N As Integer

'--------------FUNCIONANDO aaaaaaaaaa----------------------------------------------------

Do While ActiveCell.Row <= ultcell.Row

If Count = 0 Then
If pesquisa = "" Then GoTo Done
For Each Celll In Selection
N = InStr(Celll.Value, pesquisa)
While N <> 0
Count = Count + 1
N = InStr(N + 1, Celll.Value, pesquisa)
Wend
Next Celll

'----------------testando o segundo >----------------------------------------------------

If Count = 0 Then
If pesquisadois = "" Then GoTo Done
For Each Celll In Selection
N = InStr(Celll.Value, pesquisadois)
While N <> 0
Count = Count + 1
N = InStr(N + 1, Celll.Value, pesquisadois)
Wend
Next Celll

'--------------------------tem que ser aqui se não entra em loop infinito----------------------------------------------------------

If InStr(Celula, "<") And InStr(Celula, ">") Then
Call Celula.Replace("<", "")
Call Celula.Replace(">", "")
End If

'-----------------------------------------------------------------------------------------------

MsgBox Count1 & Count2 & " Occurrences of " & pesquisa & pesquisadois 'conferindo se achou
Done:

'-----------------------------FUNCIONA O LOOP------------------------------------------------------------------


ActiveCell.Offset(1, 0).Select
texto = ActiveCell.Text

End If
End If

Loop

End Sub

Sub Macro()
Call RemoveCaracteres([A1])
End Sub

Midori · 23 de agosto de 2022

@isabela queiroz A macro que postei é para substituir o que fez no While e não para ser usada em conjunto. Tente escrever outro código mais simples e chame a Sub RemoveCaracteres no Loop passando as células como argumento. Se o range for A1:A10 fica assim,

Sub RemoveCaracteres(Celula As Range)
    If InStr(Celula, "<") And InStr(Celula, ">") Then
        Call Celula.Replace("<", "")
        Call Celula.Replace(">", "")
    End If
End Sub

Sub TestandoWhile()
    Dim Celula As Range
    
    For Each Celula In [A1:A10]
        Call RemoveCaracteres(Celula)
    Next Celula
End Sub