问合并与用户和每个单元格对应的重复单元格

EN

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