Excel VBA pra Remover Duplicidade apenas células visíveis

[Scofieldgyn]

Olá pessoal tudo bem vocês?

 

Preciso de um favor, tenho uma rotina vba que eu preciso excluir duplicidade de linhas com base em critérios de algumas colunas, eu consegui inserir o código, mas só que ele não exclui apenas as linhas com a tabela filtrada, ai quando eu coloco o comando apenas pra células visíveis, dá um erro, ou seja, ele não deixa.

 

Teria uma forma de resolver isso?

    Range("A2:U" & UltLin).Select
    Selection.SpecialCells(xlCellTypeVisible).Select 'Ele dá erro aqui
    Selection.RemoveDuplicates Columns:=Array(3, 7, 12, 16), Header:=xlYes 

 

O Filtro que eu aplico é na coluna 3, onde o valor da célula é maior que 60000000, se tiverem uma sugestão para melhorar o código em vez de deixar a tabela filtrada, agradeço.

 

[OreiaG]

Segue uma ideia. Veja se pode lhe ajudar.

 

Insere fórmulas na coluna V para retornar os registros duplicados a partir da segunda ocorrência e deleta os duplicados via Auto Filtro na coluna V.

Para simplificar coloquei na fórmula apenas o número 6, ajuste aí para o valor correto (C2<=6  e  C$2:C2;">6").

 

Sub RemoveDuplicadas()
 Application.ScreenUpdating = False
 ActiveSheet.AutoFilterMode = False
 Range("V2:V" & Cells(Rows.Count, 1).End(xlUp).Row).FormulaLocal = "=SE(C2<=6;0;CONT.SES(C$2:C2;"">6"";G$2:G2;G2;L$2:L2;L2;P$2:P2;P2))"
 If Application.CountIf([V:V], ">1") = 0 Then MsgBox "NÃO HÁ DUPLICADAS": Columns(22).Clear: Exit Sub
 [A1:V1].AutoFilter 22, ">1"
 Range("A2:V" & Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.Delete
 ActiveSheet.AutoFilterMode = False
 Columns(22).Clear
End Sub

 

[Scofieldgyn]

@OreiaG Obrigado pelo retorno.

 

Eu fiz um parecido um mês atrás, porém eu não queria fazer por fórmula pra diminuir o tempo de processamento. Cheguei fazer outro modelo conforme abaixo, ele está retirando a duplicidade normalmente, porém não está obedecendo o filtro aplicado. 

 

      Se tiver alguma sugestão, agradeço.

 

Sub duplicidade()

Dim UltLin As Long
Dim rng As Range
Dim rng2 As Range

    ActiveSheet.Range("$A$1:$S$1048576").AutoFilter Field:=3, Criteria1:=">6000000", Operator:=xlFilterValues
    
        With ActiveSheet.AutoFilter.Range
         On Error Resume Next
           Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
               .SpecialCells(xlCellTypeVisible)
         On Error GoTo 0
        End With
        If rng2 Is Nothing Then
           MsgBox "Não consta duplicidade"
        Else

           Set rng = ActiveSheet.AutoFilter.Range
           rng.Offset(1, 0).Resize(rng.Rows.Count - 1).RemoveDuplicates Columns:=Array(3, 7, 12, 16), Header:=xlYes
        End If
        
End Sub

 

[OreiaG]

39 minutos atrás, Scofieldgyn disse:

 ... eu não queria fazer por fórmula pra diminuir o tempo de processamento.

 

 

Quanto tempo dura a execução do código que você fez e quanto tempo dura a execução do código que eu sugeri ?

[Scofieldgyn]

@OreiaG o meu leva 8 segundos e o seu está levando 6 segundos.

 

Queria diminuir para 1 ou 2 segundos, sei que é possível, pois a maior parte da demora, está nesse pedaço de código pra retirar a duplicidade. 

 

Nesse último código exemplo que eu comentei anteriormente, ele leva milesimos de segundos, so que não está respeitando o filtro.

 

Mas enfim, seu código já está ajudando bastante.

[OreiaG]

1 hora atrás, Scofieldgyn disse:

 

Nesse último código exemplo que eu comentei anteriormente, ele leva milesimos de segundos, so que não está respeitando o filtro.

 

 

Tempo excelente! Talvez possamos encontrar uma forma de manter a rapidez e respeitar os dados filtrados.

Você poderia anexar o arquivo com alguns dados (10 a 15 linhas), mas os dados da coluna C precisam representar os dados reais e informe quantas linhas aproximadamente serão processadas.

[Scofieldgyn]

@OreiaG

 

Hoje seu código levou mais tempo, quase 14 segundos. 

Vou tentar montar alguma base ficticio, pois os dados reais da empresa não posso compartilhar, justa causa  na hora.