Boa tarde Leluir

Seja bem-vindo ao fórum!

Movi teu tópico para a sala VBA & Macros, pois este local é exclusivo para a apresentação dos novos usuários do fórum.

Por enquanto vou deixar o tópico sendo mostrados nos 2 locais, para você localizá-lo.

Patropi - Moderação

Boa tarde!!

Use a pesquisa do fórum!!

Sub AleVBA_11310()
     
    Dim x               As Long
    Dim LastRow         As Long
     
    LastRow = Range("A65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
            Range("A" & x).EntireRow.Delete
        End If
    Next x
     
End Sub

Att

Ola obrigado por responder bem rápido, mas o que eu quero é excluir todos os dados iguais não quero manter um dado ou seja se A1 luiz,A2 luiz, A3Luiz quero excluir todas que tiver luiz A1,A2,A3 obrigado.

Veja se assim atende:

Option Explicit

Sub Exclui_Repetidos_GT()

Application.ScreenUpdating = False

Dim i           As Integer
Dim j           As Integer
Dim intCount    As Integer
Dim sNome       As String

j = 1
Do Until IsEmpty(Cells(j, "A"))
    i = 1
    sNome = Cells(i, "A").Value
    i = 2
    intCount = 0
    Do Until IsEmpty(Cells(i, "A"))
        If Cells(i, "A").Value = sNome Then
            intCount = intCount + i
            Cells(i, "A").EntireRow.Delete
        End If
        i = i + 1
    Loop
    If intCount > 0 Then Cells(1, "A").EntireRow.Delete
    j = j + 1
Loop

Application.ScreenUpdating = True

End Sub

leluir,

Acho que as macros anteriores não funcionam pois não se deve dar "loop" nesse caso. Macro não é minha praia mas acho que essa deve funcionar.

Me avise.

Abs,

Sub Macro1()

    Range("B1").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(C[-1],RC[-1])>1,""X"","""")"
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B1000")
    Range("B1:B1000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Last = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "B").Value) = "X" Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i

End Sub

Mandrix, não tinha pensado em usar uma coluna auxiliar, boa a sacada.

Mas o código que eu escrevi, mesmo com loop, faz o mesmo que o teu código, pois eu coloquei um contador pra verificar as repetições. Contudo, a tua solução deve ser mais rápida.

Abs

Boa tarde!!
Segue minha versão.

Sub AleVBA_11310()
    Dim i   As Long
    i = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Columns(1).Insert
    [A1] = "AleVBA"
    With Range("A1:A" & i)
        .Offset(1, 0).Resize(.Rows.Count - 1, 1).Formula = "=COUNTIF($B$2:$B$" & i & ",B2)>1"
        .AutoFilter field:=1, Criteria1:="VERDADEIRO"
        .Offset(1, 0).Resize(.Rows.Count - 1, 1).EntireRow.Delete
        .AutoFilter
    End With
    Columns(1).Delete
    Application.ScreenUpdating = True
End Sub

Att

gtsalikis,

O seu código não faz o mesmo que o meu código não...O meu faz o mesmo que a segunda versão do Alexandre. Teste com outras repetições e alternâncias e me fale.

Abs,

Mandrix, me expressei mal. Desculpe.

Queria dizer que o resultado final é o mesmo (ao menos, até onde testei), mas fiz apenas loop. A sacada de vcs foi identificar tudo o que é repetido antes.

Abs.

Então... Por isso falei pra vc testar outros cenários. O loop, em tese, não proporciona o resultado correto.

Por exemplo, essas 2 séries:

laranja
laranja
banana
maçã
abacate
goiaba
kiwi
mamão
melão
maçã
pera
uva
maçã

ou

laranja
banana
laranja
maçã
abacate
goiaba
kiwi
maçã
maçã
mamão
melão
pera
uva

Depois me fale.

Abs,

Mandrix,

Tem razão. Eu testei com listas que, por acaso, deram certo, mas com os teus exemplos pude ver que a minha lógica estava errada.

As soluções que vc e o AleVBA apresentaram já resolveram o problema, porém, eu fiquei intrigado com o loop, e resolvi tentar uma última vez (apenas por curiosidade, teimosia, e pra passar o tempo, rsrs).

Option Explicit

Sub Exclui_Repetidos_GT()

Application.ScreenUpdating = False

Dim i           As Integer
Dim j           As Integer
Dim intCount    As Integer
Dim sNome       As String
Dim UL          As Integer

j = 1
Do Until IsEmpty(Cells(j, "A"))
    UL = Cells(Rows.Count, "A").End(xlUp).Row
    sNome = Cells(j, "A").Value
    i = UL
    intCount = 0
    Do Until i = j
        If Cells(i, "A").Value = sNome Then
            intCount = intCount + 1
            Cells(i, "A").EntireRow.Delete
        End If
        i = i - 1
    Loop
    If intCount > 0 Then
        Cells(j, "A").EntireRow.Delete
    Else
        j = j + 1
    End If
Loop

Application.ScreenUpdating = True

End Sub

Obrigado a todos que me ajudaram a solucionar meu problema abraços

Boa noite!!

Eu fico feliz, por ter ajudado!!

Att