ユーザーと各セルに対応する重複セルをマージする

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のコードは、上記のコードを記述するために参照されています。