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

2

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:

wprowadź opis zdjęcia tutaj

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:

wprowadź opis zdjęcia tutaj

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!

Zefir
źródło

Odpowiedzi:

1

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:

Arkusz 1


Wynik - RemoveRowDupes ()

Sheet1RemoveRowDupes


Wynik - dostuff ()

Sheet1dostuff


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

Paul Bica
źródło
Wygląda dobrze, @paul bica, ale kiedy go uruchamiam, nic się nie dzieje. Nie znam VBA, ale dodałem moduł do arkusza z moimi danymi i wkleiłem twój kod. Jak miałbym to uruchomić w moim zasięgu?
Zephyr
W tej chwili arkusz jest tylko domyślnym arkuszem 1, który wydaje się pasować do tego, co znajduje się w kodzie.
Zephyr
Nie pasuje (musi być dokładnie): Arkusz 1 ma spację przed 1. Albo usuń spację, albo przejdź do edytora VBA i spójrz na lewy górny panel: zobaczysz 2 nazwy dla tego samego arkusza (Wiem - może to być mylące), ale powiedz mi (dokładne) nazwy swojego arkusza z danymi
Paul
Cóż, więc jestem zdezorientowany. W oknie VBA żądany arkusz jest wyświetlany jako „Arkusz2 (Arkusz1)”, a kod odwołuje się do „Arkusz1.UsedRange”. Próbowałem zmienić go na Sheet2.UsedRange, ale znowu bez efektu.
Zephyr
Ach, znalazłem to! Okazuje się, że dodałem ogólny moduł, ale tak naprawdę nie został dodany do odpowiedniego arkusza. Wykonanie tego i przejście na Arkusz 2 działało idealnie. Dziękuję Ci!
Zephyr
0

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
Sir Adelaide
źródło
0

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.

wprowadź opis zdjęcia tutaj

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

Bandersnatch
źródło