Página 1 de 1

Adaptar Rotina VBA para Excluir Linhas com Diversos Critérios

Enviado: Qui Set 12, 2019 9:41 am
por jlvfranca
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



Encontrei uma outra rotina mais dinâmica, mas estou apanhando para adaptá-la as minhas necessidades. Quero incluir na rotina, abaixo, os seguintes critérios.
    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”.

        Sub ExcluirLinha2()
        Dim vDeletaValor As String
        Dim vRange As Range
        Dim vModoCalcular As Long
        With Application
        vModoCalcular = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        End With
        vDeletaValor = "Assistidos"
        With ActiveSheet
        .AutoFilterMode = False
        .Range("N2:N" & .Rows.Count).AutoFilter Field:=1, Criteria1:=vDeletaValor
        With ..AutoFilter.Range
        On Error Resume Next
        Set vRange = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
        .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not vRange Is Nothing Then vRange.EntireRow.Delete
        End With
        .AutoFilterMode = False
        End With
        With Application
        .ScreenUpdating = True
        .Calculation = vModoCalcular
        End With
        End Sub

        Alguém poderia me ajudar?
        Agradeço antecipadamente,

        jlvfrança

        Re: Adaptar Rotina VBA para Excluir Linhas com Diversos Critérios

        Enviado: Qui Set 12, 2019 10:46 am
        por Julio Mangilli
        Olá Amigo,

        Verifica se isso te ajuda.

        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
        With ActiveSheet
        i = firstRow
        While i < lastRow
        If CStr(.Cells(i, criteriaColumn).Value) = criteria Then
        .Rows(i).Delete
        deletedRows = deletedRows + 1
        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

        Re: Adaptar Rotina VBA para Excluir Linhas com Diversos Critérios

        Enviado: Sex Set 13, 2019 1:05 pm
        por jlvfranca
        Julio, boa tarde.

        Obrigado pela disponibilidade em ajudar-me.
        A rotina posta ajudou, mas quando tento adaptá-la para atender as minha necessidades ainda não estou conseguindo.
        Alterei a linha abaixo para diferente. Preciso excluir os diferentes de "Assistidos", porém a rotina entrou em loop fica carregando eternamente, só funciona se eu trocar o sinal para igual.

        If CStr(.Cells(i, criteriaColumn).Value) <> criteria Then

        Alguma sugestão?

        Re: Adaptar Rotina VBA para Excluir Linhas com Diversos Critérios

        Enviado: Sex Set 13, 2019 4:27 pm
        por Julio Mangilli
        Boa Tarde,

        Bah eu tinha entendido errado, perdão era para ser diferente... para manter aquelas. kkkk

        Veja essa se ajuda..
        Sub Exemplo()

        Dim lRow As Long
        Dim lLast As Long

        lLast = Plan1.UsedRange.Rows.Count

        For lRow = lLast To 2 Step -1
        If _
        Cells(lRow, "AM") Like "Assistidos" Then

        Else
        Rows(lRow).Delete
        End If
        Next lRow
        End Sub