none
Linha - Deletar a linha com duplicidade e suas duas linhas imediatamente seguintes RRS feed

  • Pergunta

  • Continuando a minha solicitação de ajuda para a resolução de problemas com minha planilha.

    Agora necessito de uma macro que remova as linhas que contem os diversos casos de duplicidade na coluna C.

    É o seguinte:

    Na coluna C da planilha existem diversos casos de duplicidade.

    Exemplo de duas duplicidades:

    Linha 10 com 1ª exibição (a original):                  Maria

    Linha 14 com 2ª exibição (a duplicidade):             Maria

    Linha 21 com 1ª exibição (a original):                  Pedro

    Linha 26 com 2ª exibição (a duplicidade):             Pedro

    E assim deste modo estão os outros nomes em duplicidade na coluna C da planilha.

    Estas duplicidades de um nome só aparecem uma vez na planilha, não existe no resto planilha outras Maria e Pedro.

    O que macro deverá fazer:

    Percorrer a coluna C e ao encontrar a segunda linha que contem a duplicidade da linha anterior próxima, deverá deletar esta segunda linha encontrada, juntamente com a 2 linhas logo abaixo dela.

    Para evitar a desconfiguração lógica do texto da planilha, a macro não poderá deletar a linha original primeiramente encontrada.

    Tem que ser deletada sempre a linha seguinte encontrada, ou seja, a que contem a duplicidade, juntamente com a 2 linhas logo abaixo dela.

    E assim sucessivamente com as demais duplicidades na coluna C até o final da palhinha.

    A coluna C contém diversas células vazias, além das que possuem duplicidade ou não.

    Agradeço a ajuda.

    terça-feira, 5 de agosto de 2014 01:56

Respostas

  • Olá Oscar!

    Teste esse código:

    Sub Apagar_Linhas_Repetidas()
        
        Dim strNome As String
        Dim linha As Integer
        linha = 2
        
        Do Until Range("A" & linha) = ""
            Range("C" & linha).Select
            If ActiveCell.Value = "" Then
                linha = linha + 1
            Else
                strNome = ActiveCell.Text
                ActiveCell.FormulaR1C1 = "=COUNTIF(R1C3:R[-1]C[0]," & """" & strNome & """" & ")"
                If ActiveCell.Value >= 1 Then
                    ActiveCell.Rows("1:3").EntireRow.Select
                    Selection.Delete Shift:=xlUp
                    Else
                    ActiveCell.Value = strNome
                    linha = linha + 1
                End If
            End If
        Loop
            
    End Sub

    Eu criei através do laço de repetição DO UNTIL, que vai repetir o código até que a coluna A apresente uma célula vazia. Se houver buracos vazios na coluna A, substitua a letra na linha abaixo pela letra de alguma coluna que contenha todas as linhas preenchidas com algum valor para ele fazer a varredura em toda sua tabela.

    Do Until Range("A" & linha) = ""

    Rafael Kamimura

    terça-feira, 5 de agosto de 2014 12:03

Todas as Respostas

  • Bom dia Oscar,

    Veja se a rotina abaixo, lhe auxilia na sua tarefa.

    Sub Remover()
    For Each c In Range("C1:C500")
        If c <> "" Then
            For Each b In Range("C1:C500")
                If c = b And c.Address <> b.Address Then
                    Rows(b.Row & ":" & b.Row + 2).Select
                    Selection.Delete
                    Exit For
                End If
            Next
        End If
    Next
    End Sub

    Á disposição,

    Abraço.



    terça-feira, 5 de agosto de 2014 11:56
  • Olá Oscar!

    Teste esse código:

    Sub Apagar_Linhas_Repetidas()
        
        Dim strNome As String
        Dim linha As Integer
        linha = 2
        
        Do Until Range("A" & linha) = ""
            Range("C" & linha).Select
            If ActiveCell.Value = "" Then
                linha = linha + 1
            Else
                strNome = ActiveCell.Text
                ActiveCell.FormulaR1C1 = "=COUNTIF(R1C3:R[-1]C[0]," & """" & strNome & """" & ")"
                If ActiveCell.Value >= 1 Then
                    ActiveCell.Rows("1:3").EntireRow.Select
                    Selection.Delete Shift:=xlUp
                    Else
                    ActiveCell.Value = strNome
                    linha = linha + 1
                End If
            End If
        Loop
            
    End Sub

    Eu criei através do laço de repetição DO UNTIL, que vai repetir o código até que a coluna A apresente uma célula vazia. Se houver buracos vazios na coluna A, substitua a letra na linha abaixo pela letra de alguma coluna que contenha todas as linhas preenchidas com algum valor para ele fazer a varredura em toda sua tabela.

    Do Until Range("A" & linha) = ""

    Rafael Kamimura

    terça-feira, 5 de agosto de 2014 12:03
  • OK, Rafael, funcionou!!

    Mais uma vez, muito obrigado.

    terça-feira, 5 de agosto de 2014 21:27
  • Olá Oscar! Só quero fazer um comentário sobre suas marcações de respostas. A resposta marcada não deve ser o seu comentário, mas sim o comentário que contém a resposta de fato a sua pergunta, para que o thread fique na ordenação correta e facilite na consulta de outros usuários que possam usar a resposta como referência para problemas semelhantes. Abraços!

    Rafael Kamimura

    terça-feira, 5 de agosto de 2014 22:35
  • Rafael, estou vendo todos os casos em que há marcação incorreta de resposta e estou corrigindo.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sexta-feira, 8 de agosto de 2014 00:41
    Moderador