Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Adaptar Rotina VBA para Excluir Linhas com Diversos Critérios

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
jlvfranca
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Sex Jan 17, 2014 9:43 pm

Adaptar Rotina VBA para Excluir Linhas com Diversos Critérios

Mensagem por jlvfranca » Qui Set 12, 2019 9:41 am

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
        Anexos
        Planilha_Teste.zip
        (114.52 KiB) Baixado 9 vezes



        Disable adblock

        This site is supported by ads and donations.
        If you see this text you are blocking our ads.
        Please consider a Donation to support the site.


        Julio Mangilli
        Colaborador
        Colaborador
        Mensagens: 90
        Registrado em: Sex Out 05, 2018 2:42 pm

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

        Mensagem por Julio Mangilli » Qui Set 12, 2019 10:46 am

        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



        jlvfranca
        Acabou de chegar
        Acabou de chegar
        Mensagens: 3
        Registrado em: Sex Jan 17, 2014 9:43 pm

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

        Mensagem por jlvfranca » Sex Set 13, 2019 1:05 pm

        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?



        Julio Mangilli
        Colaborador
        Colaborador
        Mensagens: 90
        Registrado em: Sex Out 05, 2018 2:42 pm

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

        Mensagem por Julio Mangilli » Sex Set 13, 2019 4:27 pm

        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



        Disable adblock

        This site is supported by ads and donations.
        If you see this text you are blocking our ads.
        Please consider a Donation to support the site.


        Responder