I can think of three ways to do this:
- Excel functions for string manipulation
InStr()
and Len()
- Wildcards
- Regex
And different ways, some more optimized to delete
Excel functions
A normal loop on each line where two factors are checked in the string.
InStr
First if it contains the word "Defect" with the InStr () and the code InStr(1, ws.Cells(i, 10), "Defeito", 1)
, which returns 0 if there is no word and is not 0 if there is one.
Len
Then the Len () function, which verifies the length of the String, as the word defect alone has 7 characters. Then it is checked if the length is greater than 7 characters.
Loop to delete
Lastly if there is a word Defect and if the String is greater than 7 characters, a loop is performed backwards to delete each line. This is a slow process, which for more than 10 000 lines would take some time.
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
Two ways to delete with WildCard:
Match
The Excel function Match()
is used together with WildCard and is deleted by 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
Autofilter
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
Autofilter is used with wildcard and then visible lines are deleted, this method is faster than a line-by-line loop.
Regex
Regular Expressions can be used, where a demo in Regex101 can be viewed and the expression: Defeito.+
Enable Regex in Excel
RegEx needs to be enabled, Enable Developer mode
In the 'Developer' tab, click 'Visual Basic' and the VBA window will open.
Go to 'Tools' - > 'References ...' and a window will open.
Look for 'Microsoft VBScript Regular Expressions 5.5', as in the image below. And enable this option.
Code
InthiscodethecellisvalidatedbyRegex,andthenanoncontiguousRangeiscreatedandtheentirerangeisdeletedattheend.
Thismethodisfasterbyperformingthedeleteactionatonetime,thanperformingthelooponebyone.
DimUltimaLinhaAsLong,jAsLongDimwsAsWorksheetDimDados()DimstrDataAsStringDimrngAsRange,nova_rngAsRangeSetws=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
Note:
Deleting / Deleting data is very sensitive and complicated, as they can be lost forever. I suggest backing up the old data and creating a copy of the spreadsheet / data for testing.