Excel - Destaque e remova valores duplicados de coluna na linha

Question

Estou trabalhando em um documento grande que contém algumas centenas de colunas de dados. Muitas dessas linhas têm valores duplicados nas colunas que preciso remover.

Aqui está uma planilha de exemplo:

O que preciso é poder percorrer cada linha, encontrar as duplicatas nas colunas B:E e excluir todas as células, exceto uma, de preferência deslocando o restante das células para a esquerda para evitar células em branco. Eu precisaria manter todas as linhas e o restante dos dados intactos.

Então, dado o exemplo acima, o resultado ficaria assim:

Algumas notas:

• Todas as células em questão aparecem no final de cada linha
• Raciocínio: Todos esses valores foram armazenados como uma lista em uma única coluna e divididos usando Text to Columns. Agora preciso limpá-lo e remover as duplicatas.
• Existem milhares de linhas e algumas centenas de colunas extras que podem ter duplicatas.

Isso é possível, mesmo com VBA? Qualquer sugestão é muito apreciada. Obrigado!

Answer 1

Aqui estão os resultados do teste de velocidade para as respostas postadas (10 mil linhas e 1 mil colunas):

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

---

Dados de teste:

---

Resultado - RemoveRowDupes()

---

Resultado - dostuff()

---

Observação:esta resposta pode ser melhorada (se necessário) usando arrays em vez de interagir com o intervalo

Answer 2

Se você quiser usar VB para processar os dados no local, poderá usar o seguinte:

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

Você pode fazer isso com uma fórmula, mas os valores corretos estarão em um local diferente, pelo menos temporariamente. Para manter seus dados no mesmo local, você pode copiar os novos dados e Colar Especial > Valores sobre os dados antigos.

Esta fórmula de matriz, preenchida à direita e abaixo de B7, fornece os resultados mostrados abaixo:

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

Observe que esta é uma fórmula de matriz e deve ser inserida com CTRLShiftEnter.

Um tutorial sobre como esta fórmula funciona é fornecido emExceljet.