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

Question

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.

Answer 1

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.

Answer 2

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

Answer 3

OK, Rafael, funcionou!!

Mais uma vez, muito obrigado.

Answer 4

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

Answer 5

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