Macros para eliminar números repetidos de las filas y dejar solo un de los que se repite y mantener el resto.

[cathyuska]

Hola a todos:

Necesito si pueden ayudar a crear una macros que elimine los números que se repiten en cada fila y deje solo uno de ellos, manteniendo el resto, para después dejarlos en la misma fila con una columna de espacio. 

Nose si se entiende, pero envio una muestra de lo que necesito, porque mi archivo tiene más de 1000 filas y varias hojas. 

Gracias desde ya.

Muestra.xlsm

[Israel Cassales]

En base a lo explicado una sentencia como esta debería realizar lo que solicitas:

Sub EliminarDuplicados()
    Dim ws As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim dict As Object
    Dim i As Long, j As Long

    ' AYUDA EXCEL: Establecer la hoja de trabajo
    Set ws = ThisWorkbook.Sheets("Hoja1")

    ' AYUDA EXCEL: Recorrer cada fila
    For i = 3 To 36
        ' AYUDA EXCEL: Establecer el rango de celdas a revisar
        Set rng = ws.Range(ws.Cells(i, "A"), ws.Cells(i, "AB"))

        ' AYUDA EXCEL: Crear un nuevo objeto diccionario
        Set dict = CreateObject("Scripting.Dictionary")

        ' AYUDA EXCEL: Recorrer cada celda en el rango
        For Each c In rng
            ' AYUDA EXCEL: Si el número no está en el diccionario, añadirlo
            If Not dict.exists(c.Value) Then
                dict.Add c.Value, ""
            End If
        Next c

        ' AYUDA EXCEL: Colocar los números únicos en el rango AD3:BE36
        j = 30
        For Each Key In dict.keys
            ws.Cells(i, j).Value = Key
            j = j + 1
        Next Key

        ' AYUDA EXCEL: Limpiar
        Set dict = Nothing
        Set rng = Nothing
    Next i

    ' AYUDA EXCEL: Limpiar
    Set ws = Nothing
End Sub

 

[Israel Cassales]

El libro

Muestra - AYUDA EXCEL.xlsm

[Israel Cassales]

Adicional:

Por si cambias los números del primer rango y los vuelves a pasar al segundo bastaría con agregar este parte de código:

' AYUDA EXCEL: Limpiar el rango AD3:BE36
ws.Range("AD3:BE36").ClearContents

Esta línea podría ir justo después de establecer la Hoja y antes de comenzar a recorrer cada fila. Lo que harías es eliminar cualquier contenido que pueda estar en el rango AD3:BE36 antes de que la macro comience a pegar los nuevos datos. Así podrías asegurarte que no haya datos "viejos" en esas celdas, si es que pegas de nuevo verdad.

Muestra - AYUDA EXCEL.xlsm

[cathyuska]

muchas gracias

[cathyuska]

Hola,

¿como puedo ajustarla para que se  ejecute en los archivos de una carpeta especifica y se guarde automáticamente?

Gracias

[Antoni]

Ejecuta la macro del adjunto:

Sub EliminarDuplicados()
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Copy
Range("AD1").PasteSpecial Transpose:=True
For y = Range("AD1").Column To Range("BK1").Column
   Range(Cells(2, y), Cells(28, y)).RemoveDuplicates Columns:=1
Next
Range("AD1").CurrentRegion.Copy
Range("BM1").PasteSpecial Transpose:=True
Range("AD:BL").Delete
Range("AD1").Select
End Sub

 

Muestra (1).xlsm

[JSDJSD]

Lo mismo pero sin copiarlo a otro sitio.

[JSDJSD]

Sub EliminarDuplicadosYOrdenarPorFila(): Application.ScreenUpdating = False
    Dim ultimaFila As Long
    Dim ultimaColumna As Long
    Dim rangoFila As Range
    Dim valoresUnicos As Collection
    Dim celda As Range
    Dim i As Long
    
    With Hoja2
    ultimaFila = .Cells(.Rows.Count, "A").End(xlUp).Row
    ultimaColumna = .Cells(3, "AB").Column

    For i = 3 To ultimaFila
        Set rangoFila = .Range(.Cells(i, 1), .Cells(i, ultimaColumna))
        Set valoresUnicos = New Collection
        For Each celda In rangoFila
            On Error Resume Next
            valoresUnicos.Add celda.value, CStr(celda.value)
            On Error GoTo 0
        Next celda
        rangoFila.ClearContents
        For j = 1 To valoresUnicos.Count
            .Cells(i, j).value = valoresUnicos(j)
        Next j
        .Range(.Cells(i, 1), .Cells(i, valoresUnicos.Count)).Sort key1:=.Cells(i, 1), order1:=xlAscending, Header:=xlNo
    Next i
    End With
End Sub

El archivo

Muestra3.xlsm

[cathyuska]

Hola, tengo una carpeta que se llama trabajo, ahí tengo muchos archivos como la Muestra del tema. Que debo eliminar los repetidos dejando solo 1 y manteniendo el resto. como la primera macros q si me ayuda, . pero como son muchos archivos me demoro mucho, entonces mi pregunta es cómo puedo hacer para que esa macros se ejecute en todos los archivos de esa carpeta sin yo abrirlos y que se guarde automáticamente.

gracias