Excel - Podświetl i usuń zduplikowane wartości kolumn w wierszu

Pracuję nad dużym dokumentem, który ma kilkaset kolumn danych. Wiele z tych wierszy ma zduplikowane wartości w kolumnach, które muszę usunąć.

Oto przykładowy arkusz:

Potrzebuję, aby móc przejść przez każdy wiersz, znaleźć duplikaty w kolumnach B: E i usunąć wszystkie komórki oprócz jednej, najlepiej przesuwając resztę komórek w lewo, aby uniknąć pustych komórek. Musiałbym zachować wszystkie wiersze i resztę ich danych nienaruszonych.

Biorąc pod uwagę powyższy przykład, wynik wygląda następująco:

Kilka notatek:

• Komórki, o których mowa, pojawiają się na końcu każdego wiersza
• Uzasadnienie: Wszystkie te wartości zostały zapisane jako lista w jednej kolumnie i podzielone za pomocą Text to Columns. Teraz muszę to wyczyścić i usunąć duplikaty.
• Istnieją tysiące wierszy i kilkaset dodatkowych kolumn, które mogą mieć duplikaty.

Czy to możliwe, nawet z VBA? Wszelkie sugestie są bardzo mile widziane. Dziękuję Ci!

Oto wyniki testu szybkości dla opublikowanych odpowiedzi (10 000 wierszy i 1 000 kolumn):

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

Dane testowe:

Wynik - RemoveRowDupes ()

Wynik - dostuff ()

Uwaga: tę odpowiedź można poprawić (w razie potrzeby) za pomocą tablic zamiast interakcji z zakresem

Jeśli chcesz użyć VB do przetwarzania danych w miejscu, możesz użyć następujących opcji:

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

Możesz to zrobić za pomocą formuły, ale poprawne wartości będą znajdować się w innym miejscu, przynajmniej tymczasowo. Aby zachować dane w tej samej lokalizacji, możesz skopiować nowe dane i Wklej specjalnie> Wartości nad starymi danymi.

Ta formuła tablicowa, wypełniona w prawo i w dół od B7, daje wyniki pokazane poniżej:

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

Zauważ, że jest to formuła tablicowa i należy ją wprowadzić za pomocą CTRLShiftEnter.

Samouczek dotyczący działania tej formuły znajduje się w Exceljet .