合并对应于用户和每个单元的重复单元

Question

我有一个大约50000行和大约1200列的工作表。每行对应一个用户，每个单元格是他购买的产品。我需要识别重复的产品并将其删除。

  A   |   B  |   C  |   D  |   E  |   F  |   G  |   H
------|------|------|------|------|------|------|--------
user1 | pro1 | pro1 | pro2 | pro3 | pro4 | pro3 | pro2...  
user2 | pro1 | pro3 | pro1 | pro3 | pro2 | pro3 | pro2..  
user3 | pro1 | pro3 | pro2 | pro3 | pro1 | pro3 | pro2..  
user4 | pro1 | pro1 | pro2 | pro5 | pro3 | pro3 | pro2..

到

  A   |   B  |   C  |   D  |   E  |   F  |   G  |   H
------|------|------|------|------|------|------|-------
user1 | pro1 | pro2 | pro3 | pro4 |      |      |
user2 | pro1 | pro2 | pro3 |      |      |      |  
user3 | pro1 | pro2 | pro3 |      |      |      |
user4 | pro1 | pro2 | pro3 | pro5 |      |      |

我尝试了一个代码，但它适用于100行，但30000行却没有响应

Answer 1

试试这个：

Sub UniqueValsInRow()
    Dim MyCol As New Collection
    Dim ColItem
    Dim CellVal As Variant
    Dim LastRow As Long, LastColumn As Long, ColCount As Long
    Dim vTemp As Variant
    Dim i As Long, j As Long, r As Long, c As Long
    Dim wsInput As Worksheet, wsOutput As Worksheet

    Set wsInput = ActiveWorkbook.Sheets("Sheet1")   '---> enter you sheet name here
    LastRow = wsInput.Cells(Rows.Count, "A").End(xlUp).Row   '---> will give no. of rows

    For r = 1 To LastRow
        LastColumn = wsInput.Cells(r, Columns.Count).End(xlToLeft).Column   '---> will give no. of columns in each row

        'add values to collection
        For c = 2 To LastColumn
            CellVal = wsInput.Cells(r, c).Value
            On Error Resume Next
            MyCol.Add CellVal, Chr(34) & CellVal & Chr(34)
            On Error GoTo 0
        Next c

        'sort items in collection
        For i = 1 To MyCol.Count - 1
            For j = i + 1 To MyCol.Count
                If MyCol(i) > MyCol(j) Then
                   vTemp = MyCol(j)
                   MyCol.Remove j
                   MyCol.Add vTemp, vTemp, i
                End If
            Next j
        Next i

        'delete row data
        wsInput.Range(Cells(r, 2), Cells(r, LastColumn)).ClearContents

        'enter unique sorted items from collection to row
        ColCount = 2
        For Each ColItem In MyCol
            wsInput.Cells(r, ColCount).Value = ColItem
            ColCount = ColCount + 1
        Next

        Set MyCol = New Collection
    Next r
End Sub

这是我在运行代码后获得的结果：

注意：在运行代码之前备份数据。

@ SiddharthRout和@ DickKusleika的代码已被提到上面写的代码。