Macro Excel: En un listado importado de un archivo txt necesito borrar la fila de la primera ocurrencia duplicada

Te anexo la macro.

Cambia en la macro "Hoja1" por el nombre de tu hoja con datos.

Crea una hoja llamada "Hoja2" y ejecuta la macro

Sub Macro1()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.Cells.ClearContents
    h1.Columns("A:B").Copy h2.Range("A1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    With h2.Range("C1:C" & u)
        .FormulaR1C1 = "=COUNTIF(RC[-2]:R5C1,RC[-2])"
        .Value = .Value
    End With
    For i = u To 1 Step -1
        If h2.Cells(i, "C") > 1 Then
            h1.Rows(i).Delete
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Hola Dante, disculpame pero no te explique bien el contenido de la hoja que es como sigue:

Filas 1 a 4 hay un encabezado, los datos para la macro empiezan desde la 5 hacia abajo.

Las columnas son:

C1: ID,   C2: Area,   C3: Nombre   C4-C8: otra informacion no relevante como Cantidad, etc.

Entonces el "Nombre" duplicado a buscar está en la columna C y empieza desde la fila 5.

Gracias.

Te anexo la macro actualizada

Sub Macro1()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.Cells.ClearContents
    h1.Columns("C:C").Copy h2.Range("A1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    With h2.Range("C1:C" & u)
        .FormulaR1C1 = "=COUNTIF(RC[-2]:R5C1,RC[-2])"
        .Value = .Value
    End With
    For i = u To 5 Step -1
        If h2.Cells(i, "C") > 1 Then
            h1.Rows(i).Delete
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta.

Dante, la macro borró las dos primeras filas con valores duplicados, desde el tercer duplicado está dejando la primera ocurrencia y borrando las posteriores y siempre debe quedar el ultimo valor duplicado. Te adjunto unas cuantas lineas del archivo txt para que lo verifiques.

C 9558.0 2463 .513 705544.7 2186901.2 526.6 0.4
C 9558.0 2463 .813 705549.8 2186900.1 526.6 0.2
C 9558.0 2464 .213 705555.0 2186899.0 526.7 0.2
C 9558.0 2464 .513 705559.5 2186898.0 526.8 0.2
C 9558.0 2464 .813 705564.7 2186896.8 526.9 0.2
C 9558.0 2465 .213 705569.6 2186895.8 527.0 0.2
C 9558.0 2465 .513 705574.3 2186894.8 527.1 0.1
C 9558.0 2465 .813 705579.3 2186893.8 527.2 0.1
C 9558.0 2466 .213 705584.7 2186892.7 527.3 0.5
C 9558.0 2466 .513 705589.3 2186891.8 527.4 0.2
C 9558.0 2466 .813 705594.1 2186890.8 527.5 0.1
C 9558.0 2467 .213 705599.2 2186889.7 527.5 0.3
C 9558.0 2467 .513 705604.4 2186888.6 527.6 0.7
C 9558.0 2467 .813 705609.2 2186887.6 527.7 0.5
C 9558.0 2468 .21 3 705614.0 2186886.5 527.7 0.6
C 9558.0 2468 .51 3 705618.3 2186885.7 527.6 0.1
C 9558.0 2468 .81 3 705623.5 2186884.6 527.6 0.2

Un consejo para las siguientes consultas, pon tu información real desde un principio.

Te anexo la macro actualizada:

Sub Macro1()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.Cells.ClearContents
    u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
    h1.Range("C5:C" & u1).Copy h2.Range("C5")
    u = h2.Range("C" & Rows.Count).End(xlUp).Row
    With h2.Range("D5:D" & u)
        .FormulaR1C1 = "=COUNTIF(R5C3:RC[-1],RC[-1])"
        .Value = .Value
    End With
    For i = u To 5 Step -1
        If h2.Cells(i, "D") > 1 Then
            h1.Rows(i).Delete
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta.

Dante, mi explicación fue para que se entienda más fácil, pero tienes razón, en un próximo problema mencionaré tal y como es desde un principio.

La macro sigue dejando la primera ocurrencia y borrando las posteriores. Necesito por favor que deje la ultima ocurrencia y borre las anteriores.

La macro completa es como sigue:

Sub COG()
'
' COG Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
Range("A5:H20006").Select
Selection.ClearContents
Range("A5").Select
name_f = Application.GetOpenFilename("Archivos de sps (*.*),*.*", , "Abrir Archivo COG", , False)
If name_f = False Then
Exit Sub
End If
Workbooks.OpenText Filename:= _
name_f, Origin:=437, StartRow:=29, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 1), Array(3, 1), Array(17, 1), Array(24, 1), Array(28, 1), Array(38, 1), Array(49, _
1), Array(56, 1), Array(73, 1)), TrailingMinusNumbers:=True
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("CR macros.xlsm").Activate
ActiveSheet.Paste
Application.ScreenUpdating = False
Set h1 = Sheets("COG")
Set h2 = Sheets("Hoja2")
h2.Cells.ClearContents
u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
h1.Range("C5:C" & u1).Copy h2.Range("C5")
u = h2.Range("C" & Rows.Count).End(xlUp).Row
With h2.Range("D5:D" & u)
.FormulaR1C1 = "=COUNTIF(R5C3:RC[-1],RC[-1])"
.Value = .Value
End With
For i = u To 5 Step -1
If h2.Cells(i, "D") > 1 Then
h1.Rows(i).delete
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
' Range("D2:E2").Select
End Sub

Gracias.

Luis

En mis pruebas funciona la macro.

Envíame tu archivo con el que estás probando. En una hoja de excel pon el resultado esperado.

Mi correo [email protected]

En el asunto del correo escribe "luis martinez"

Va la macro actualizada

Sub COG()
'
' COG Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
    Range("A5:H20006").Select
    Selection.ClearContents
    Range("A5").Select
    name_f = Application.GetOpenFilename("Archivos de sps (*.*),*.*", , "Abrir Archivo COG", , False)
    If name_f = False Then
        Exit Sub
    End If
    Workbooks.OpenText Filename:= _
        name_f, Origin:=437, StartRow:=29, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(3, 1), Array(17, 1), Array(24, 1), Array(28, 1), Array(38, 1), Array(49, _
        1), Array(56, 1), Array(73, 1)), TrailingMinusNumbers:=True
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("CR macros.xlsm").Activate
    ActiveSheet.Paste
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("COG")
    Set h2 = Sheets("Hoja2")
    h2.Cells.ClearContents
    u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
    h1.Range("C5:C" & u1).Copy h2.Range("C5")
    u = h2.Range("C" & Rows.Count).End(xlUp).Row
    With h2.Range("D5:D" & u)
        .FormulaR1C1 = "=IF(COUNTIF(R5C3:RC[-1],RC[-1])>1,2,1)"
        .Value = .Value
    End With
    n = 5
    For i = u To 5 Step -1
        Application.StatusBar = "Procesando registro : " & n & " de : " & u
        n = n + 1
        If h2.Cells(i, "D") > 1 Then
            h1.Rows(i).delete
        End If
    Next
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta.

Dante,

Espero que hayas pasado un bonita Navidad. Te comento que un amigo examinó tu macro e hizo una modificacion en la formula y ahora los primeros duplicados son borrados, quedando el ultimo. Me dijo que hizo que el borrado sea de abajo hacia arriba.

Tu fórmula es la que sigue:

.FormulaR1C1 = "=IF(COUNTIF(R5C3:RC[-1],RC[-1])>1,2,1)"

La fórmula corregida:

.FormulaR1C1 = "=COUNTIF(R" & 5 + u & "C3:RC[-1],RC[-1])"

Saludos,

Luis Martinez