Consigo pensar em três modos de realizar esta ação:
- Funções Excel para manipulação de String
InStr()
e Len()
- Wildcards
- Regex
E maneiras diferentes, algumas mais otimizadas para deletar
Funções Excel
Um loop normal em cada linha em que dois fatores são verificados na string.
InStr
Primeiro se ela contém a palavra "Defeito" com a função InStr() e o código InStr(1, ws.Cells(i, 10), "Defeito", 1)
, que retorna 0 se não houver a palavra e diferente de 0 se houver.
Len
Depois a função Len(), que verifica o comprimento da String, como a palavra defeito sozinha possui 7 caracteres. Então é verificado se o comprimento é maior do que 7 caracteres.
Loop para apagar
Por último se houver a palavra Defeito e se a String for maior do que 7 caracteres, um loop é realizado de trás para frente para deletar cada linha. Este é um processo lento, que para mais do que 10 000 linhas levaria algum tempo.
Dim UltimaLinha As Long, i As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
For i = UltimaLinha To 2 Step -1
If InStr(1, ws.Cells(i, 10), "Defeito", 1) <> 0 And Len(ws.Cells(i, 10)) > 7 Then Rows(i).Delete Shift:=xlUp
Next i
WildCard
Duas maneiras de deletar com WildCard:
Match
A Função do Excel Match()
é usada junto com WildCard e deletada por loop.
Dim UltimaLinha As Long, i As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
For i = UltimaLinha To 2 Step -1
If Not IsError(Application.Match("Defeito " & "*", ws.Range("J" & i), 0)) Then Rows(i).Delete Shift:=xlUp
Next i
Autofiltro
Dim UltimaLinha As Long, i As Long
Dim ws As Worksheet
Dim RangeFiltrar As Range, RangeVisivel As Range
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
With ws
'Mostra os dados filtrados
If .FilterMode Then
.ShowAllData
End If
Set RangeFiltrar = .Range(.Cells(1, 10), .Cells(UltimaLinha, "J"))
RangeFiltrar.AutoFilter Field:=1, Criteria1:="Defeito " & "*", Operator:=xlFilterValues
End With
On Error Resume Next
Set RangeVisivel = ws.Range(ws.Cells(2, 10), ws.Cells(UltimaLinha, "J")).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not RangeVisivel Is Nothing Then
RangeVisivel.EntireRow.Delete
End If
If ws.FilterMode Then
ws.ShowAllData
End If
É usado o Autofiltro com wildcard e depois as linhas visíveis são deletadas, este método é mais rápido do que um loop linha por linha.
Regex
As Expressões regulares podem ser usadas, em que um demo no Regex101 pode ser visto e a expressão: Defeito.+
Habilitar o Regex no Excel
- RegEx precisa ser habilitado, Habilite o modo Desenvolvedor
- Na aba 'Desenvolvedor', clique em 'Visual Basic' e a janela do VBA irá abrir.
- Vá em 'Ferramentas' -> 'Referências...' e uma janela abrirá.
- Procure por 'Microsoft VBScript Regular Expressions 5.5', como na imagem abaixo. E habilite esta opção.
Código
Neste código a célula é validada por Regex e depois uma Range não contígua é criada e no fim a range inteira deletada.
Este método é mais rápido por realizar a ação de apagar de uma vez só, do que realizar o loop um por um.
Dim UltimaLinha As Long, j As Long
Dim ws As Worksheet
Dim Dados()
Dim strData As String
Dim rng As Range, nova_rng As Range
Set ws = ThisWorkbook.Sheets("Planilha1")
UltimaLinha = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
'Preenche dados na Matriz Dados
With ws
Dados = .Range("J1:J" & UltimaLinha).Value2
Dim objMatches As Object, objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
'Regex
objRegExp.Pattern = "Defeito.+"
objRegExp.Global = True
'Executa Regex
For j = LBound(Dados) To UBound(Dados)
strData = Dados(j, 1)
Set objMatches = objRegExp.Execute(strData)
If objMatches.Count <> 0 Then
For Each m In objMatches
'Realiza ação para cada combinação encontrada
'Debug.Print strData
If rng Is Nothing Then Set rng = .Range("J" & j) 'Define o primeiro item da range para não ocorrer erro na função Union
Set nova_rng = .Range("J" & j)
Set rng = Union(rng, nova_rng) 'Cria a range não contígua para deletar
Next m
End If
Next j
End With
rng.EntireRow.Delete
Nota:
Apagar/Deletar dados é muito sensível e complicado, pois eles podem ser perdidos para sempre. Sugiro realizar um backup dos dados antigos e criar uma cópia da planilha/dados para testes.