Excel - Destaque e remova valores de coluna duplicados na linha

Question

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

Aqui está uma folha de amostra:

Oqueeuprecisoépoderpassarporcadalinha,encontrarasduplicatasnascolunasB:Eedeletartodasascélulas,comexceçãodeuma,depreferênciamudandoorestodascélulasparaevitarcélulasembranco.Euprecisariamantertodasaslinhaseorestantedosdadosintactos.

Então,dadooexemploacima,oresultadoseriaassim:

Algumas notas:

• As células em questão aparecem todas 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 o VBA? Todas as sugestões são muito apreciadas. Obrigada!

    

Answer 1

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

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: essa resposta pode ser melhorada (se necessário) usando matrizes em vez de interagir com o intervalo

    

Answer 2

Se você quisesse usar o VB para processar os dados, você poderia 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)),"")

Note que esta é uma fórmula de matriz e deve ser digitada com CTRL Deslocar Enter .

Umtutorialsobrecomoestafórmulafuncionaédadoem Exceljet .