- 12 Set 2019 às 13:25
#48122
Prezados, bom dia.
Tenho uma rotina que vou excluindo as linhas de acordo com a palavra digita.
Sub ExcluirLinha()
Dim Col As Variant, Word As String
Let Col = InputBox("Em qual coluna devo manter o foco da busca da palavra?")
If Len(Col) > 0 And Not Col Like "*[!0-9]*" Then Col = Val(Col)
Let Word = InputBox("Que palavra devo encontrar nas Linhas para apagá-las?")
With Columns(Col)
.Replace Word, "#N/A", xlWhole
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With
End Sub
Tenho uma outra rotina, mas estou apanhando para adaptá-la. Quero excluir com os critérios abaixo.
Exclua na coluna “AM” tudo que for <> “Assistidos”;
Exclua na coluna “N” tudo que for <> “P”;
Exclua na coluna “L” tudo que for <> “Renda Mensal - Percentual” , “Renda Mensal – Vitalícia”, “Renda Mensal – Quotas” e “Renda Vitalícia em Quotas”.
Function DeleteRowsByCriteria(ByVal firstRow As Integer, ByVal lastRow As Integer, ByVal criteriaColumn As Integer, ByVal criteria As String) As Integer
Dim deletedRows As Integer
Dim i As Integer
deletedRows = 0 'mudei para 1
With ActiveSheet
i = firstRow
While i < lastRow
If CStr(.Cells(i, criteriaColumn).Value) = criteria Then 'mudei para diferente
.Rows(i).Delete
deletedRows = deletedRows + 1 ' Quando faço as alterações dá erro aqui nesta linha
Else
i = i + 1
End If
Wend
End With
DeleteRowsByCriteria = deletedRows
End Function
\----
Sub Execute()
MsgBox DeleteRowsByCriteria(1, 1000, 39, "Assistidos") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 14, "P") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Mensal - Percentual") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Mensal – Vitalícia") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Mensal – Quotas") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Vitalícia em Quotas") & " rows has been deleted"
End Sub
Alguém poderia me ajudar?
Agradeço antecipadamente,
jlvfrança
Tenho uma rotina que vou excluindo as linhas de acordo com a palavra digita.
Sub ExcluirLinha()
Dim Col As Variant, Word As String
Let Col = InputBox("Em qual coluna devo manter o foco da busca da palavra?")
If Len(Col) > 0 And Not Col Like "*[!0-9]*" Then Col = Val(Col)
Let Word = InputBox("Que palavra devo encontrar nas Linhas para apagá-las?")
With Columns(Col)
.Replace Word, "#N/A", xlWhole
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With
End Sub
Tenho uma outra rotina, mas estou apanhando para adaptá-la. Quero excluir com os critérios abaixo.
Exclua na coluna “AM” tudo que for <> “Assistidos”;
Exclua na coluna “N” tudo que for <> “P”;
Exclua na coluna “L” tudo que for <> “Renda Mensal - Percentual” , “Renda Mensal – Vitalícia”, “Renda Mensal – Quotas” e “Renda Vitalícia em Quotas”.
Function DeleteRowsByCriteria(ByVal firstRow As Integer, ByVal lastRow As Integer, ByVal criteriaColumn As Integer, ByVal criteria As String) As Integer
Dim deletedRows As Integer
Dim i As Integer
deletedRows = 0 'mudei para 1
With ActiveSheet
i = firstRow
While i < lastRow
If CStr(.Cells(i, criteriaColumn).Value) = criteria Then 'mudei para diferente
.Rows(i).Delete
deletedRows = deletedRows + 1 ' Quando faço as alterações dá erro aqui nesta linha
Else
i = i + 1
End If
Wend
End With
DeleteRowsByCriteria = deletedRows
End Function
\----
Sub Execute()
MsgBox DeleteRowsByCriteria(1, 1000, 39, "Assistidos") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 14, "P") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Mensal - Percentual") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Mensal – Vitalícia") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Mensal – Quotas") & " rows has been deleted"
MsgBox DeleteRowsByCriteria(1, 1000, 12, "Renda Vitalícia em Quotas") & " rows has been deleted"
End Sub
Alguém poderia me ajudar?
Agradeço antecipadamente,
jlvfrança
Você não está autorizado a ver ou baixar esse anexo.