Excel - 反白並刪除行中重複的列值

Question

我正在處理一個包含數百列資料的大型文件。其中許多行在我需要刪除的列中具有重複值。

這是一個樣本表：

我需要的是能夠遍歷每一行，找到 B:E 列中的重複項並刪除除一個單元格之外的所有單元格，最好將其餘單元格向左移動以避免空白單元格。我需要保持所有行及其其餘資料完好無損。

因此，根據上面的範例，結果將如下所示：

一些注意事項：

• 有問題的單元格全部出現在每行的末尾
• 推理：所有這些值都作為列表儲存在單列中，並使用 進行拆分Text to Columns。我現在需要清理它並刪除重複項。
• 有數千行和數百個額外列可能有重複項。

即使使用 VBA，這可能嗎？非常感謝任何建議。謝謝你！

Answer 1

以下是已發布答案的速度測試結果（10K 行和 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

---

測試數據：

---

結果-RemoveRowDupes()

---

結果 - dostuff()

---

筆記：這個答案可以透過使用陣列而不是與範圍互動來改進（如果需要）

Answer 2

如果您想使用VB就地處理數據，您可以使用以下命令：

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

您可以使用公式來執行此操作，但正確的值將位於不同的位置，至少暫時如此。若要將資料保留在同一位置，您可以複製新資料並透過「選擇性貼上」>「值」覆蓋舊資料。

此數組公式從 B7 向右向下填充，給出的結果如下所示：

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

請注意，這是一個陣列公式，必須使用 來輸入CTRLShiftEnter。

有關此公式如何運作的教程位於精捷。