Excel: resalte y elimine valores de columna duplicados en la fila

Question

Estoy trabajando en un documento grande que tiene un par de cientos de columnas de datos. Muchas de estas filas tienen valores duplicados en las columnas que necesito eliminar.

Aquí hay una hoja de muestra:

Lo que necesito es poder revisar cada fila, encontrar los duplicados en las columnas B:E y eliminar todas las celdas menos una, preferiblemente desplazando el resto de las celdas a la izquierda para evitar celdas en blanco. Necesitaría mantener intactas todas las filas y el resto de sus datos.

Entonces, dado el ejemplo anterior, el resultado sería el siguiente:

Un par de notas:

• Todas las celdas en cuestión aparecen al final de cada fila.
• Razonamiento: todos estos valores se almacenaron como una lista en una sola columna y se dividieron usando Text to Columns. Ahora necesito limpiarlo y eliminar los duplicados.
• Hay miles de filas y un par de cientos de columnas adicionales que pueden tener duplicados.

¿Es esto posible, incluso con VBA? Cualquier sugerencia es bienvenida. ¡Gracias!

Answer 1

Aquí están los resultados de la prueba de velocidad para las respuestas publicadas (10.000 filas y 1.000 columnas):

VBA 1 - Time:  19.488 sec - RemoveRowDupes (this answer)

VBA 2 - Time: 109.434 sec - dostuff (after turning off ScreenUpdating)

Formula test: N/A (gave up after 5 minutes filling out 10Kx1K range with array, at 9%)

---

Option Explicit
Public Sub RemoveRowDupes()
    Dim ur As Range, cc As Long, r As Range, a As Variant
    Dim s As String, i As Long, l As Long, t As Long, tt As Double, tr As String
    tt = Timer
    Set ur = Sheet1.UsedRange
    cc = ur.Columns.Count - 1
    With ur.Offset(, 1).Resize(, cc)
        Application.ScreenUpdating = False
        For Each r In .Rows
            s = Join(Application.Transpose(Application.Transpose(r)), "|")
            a = Split(s, "|"):
            l = Len(s)
            For i = 0 To cc - 1
                If Len(a(i)) > 0 Then
                    s = Replace(s, a(i), "^^")
                    s = Replace(s, "^^", a(i), , 1)
                    s = Replace(s, "^^", vbNullString)
                    If l > Len(s) Then
                        a = Split(s, "|")
                        l = Len(s)
                    End If
                End If
            Next
            s = Replace(s, "||", "|")
            If Right(s, 1) = "|" Then s = Left(s, Len(s) - 1)
            t = Len(s) - Len(Replace(s, "|", ""))
            r.ClearContents:    r.Resize(, t + 1) = Split(s, "|")
        Next
        Application.ScreenUpdating = True
    End With
    tr = "Rows: " & Format(ur.Rows.Count,"#,###") & "; Cols: " & Format(cc,"#,###") & "; "
    Debug.Print tr & "Time: " & Format(Timer - tt, "0.000") & " sec - RemoveRowDupes()"
End Sub

---

Datos de prueba:

---

Resultado: RemoveRowDupes()

---

Resultado - dostuff()

---

Nota:esta respuesta se puede mejorar (si es necesario) usando matrices en lugar de interactuar con el rango

Answer 2

Si desea utilizar VB para procesar los datos en su lugar, puede utilizar lo siguiente:

Sub dostuff()
Dim myarray As Variant
ReDim myarray(10000)

i = 0 'row iterator

Do While (Range("A1").Offset(i, 0).Value <> "")
 j = 0 'single item iterator
 k = 0 'column iterator
 m = 0 'stored array iterator
 m_max = 0 'number of unique values on the row

 'iterate single values
 Do While (Range("B1").Offset(i, j).Value <> "")
  temp = Range("B1").Offset(i, j).Value

  'compare to saved
  flag = 0
  m = 0
  Do While (m <= m_max)
   If temp = myarray(m) Then
     flag = 1
   End If
   m = m + 1
  Loop

  'add if unique
  If flag = 0 Then
   m_max = m_max + 1
   myarray(m_max) = temp
  End If

  j = j + 1
 Loop

 'clear existing
 Range("B1").Offset(i, 0).Select
 Range(Selection, Selection.End(xlToRight)).Clear

 'write saved
 m = 1
 Do While m <= m_max
  Range("B1").Offset(i, m - 1).Value = myarray(m)
  m = m + 1
 Loop

  i = i + 1
Loop
End Sub

Answer 3

Puedes hacer esto con una fórmula, pero los valores correctos estarán en una ubicación diferente, al menos temporalmente. Para mantener sus datos en la misma ubicación, puede copiar los datos nuevos y Pegado especial > Valores sobre los datos antiguos.

Esta fórmula matricial, completada hacia la derecha y hacia abajo desde B7, proporciona los resultados que se muestran a continuación:

=IFERROR(INDEX($B1:$E1,,MATCH(0,COUNTIF($A7:A7,$B1:$E1),0)),"")

Tenga en cuenta que esta es una fórmula matricial y debe ingresarse con CTRLShiftEnter.

Se ofrece un tutorial sobre cómo funciona esta fórmula enexceljet.