Este fórum está sendo desativado

[MARCAO1974]

Boa tarde!

Sou Marcos, ingressei hoje no forum, e estou com uma grande dificuldade em criar uma macro que verifique alguns dados constantes em uma linha (duplicados) e exclua as linhas duplicadas mantendo apenas a linha que conter o menor numero de dias.

[Feka]

Seja um pouco mais especifico, quais são os campos que não podem ter duplicatas?

[alexandrevba]

Boa tarde!!

Seria isso?

Código: Selecionar todos

Sub AleVBA_4260()
Application.ScreenUpdating = 0
    [V1].Value = "AleVBA"
    [W1].Value = "Filtro"
    [V2].FormulaArray = "=MIN(IF(B2=$B$2:$B$3496,$U$2:$U$3496))"
    [W2].FormulaArray = "=IF(AND(COUNTIF($B$2:$B$3496,B2)>1,V2=U2),1,0)"
    Range("V2:W2").AutoFill Destination:=Range("V2:W" & Cells(Rows.Count, 1).End(xlUp).Row)
    Range("V2:W" & Cells(Rows.Count, 1).End(xlUp).Row).Value = Range("V2:W" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    Range("R:R").Delete
    'Deleta dados
        Dim rng As Range
        Set rng = Range("A1").CurrentRegion
         
        With rng
            .AutoFilter Field:=22, Criteria1:="1"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        ActiveSheet.AutoFilterMode = False
        Range("U:V").Delete
Application.ScreenUpdating = 1

End Sub

Att

[MARCAO1974]

Seja um pouco mais especifico, quais são os campos que não podem ter duplicatas?

Somente a coluna dias não terá valor duplicado para a mesma pessoa.

[alexandrevba]

Bom dia!

Você testou meu código?

Att

[MARCAO1974]

Alexandre, bom dia!

Primeiro obrigado pela ajuda, testei a pouco o código e deu um erro 1004, o método autofilter da range parou. Não consegui executar.

[Feka]

Caro,

Acho que esse código atende o que você quer:

Código: Selecionar todos

Sub teste()
Plan1.Range("A1:U" & Range("u1048576").End(xlUp).Row).Sort Range("u1"), xlAscending, , , , , , xlYes
Plan1.Range("A1:U" & Range("u1048576").End(xlUp).Row).RemoveDuplicates Array(1, 2, 3, 4, 5, 6 _
 , 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20), xlYes
End Sub

[MARCAO1974]

Feka, bom dia!

Funcionou o código, obrigado a vc e todos os que tentaram de alguma forma me auxiliar.