如何在Excel中对每行数据横向提取唯一值？

需求说明 #

你有如下原始数据（每行存在重复值）：

Cat   Dog   Monkey Monkey    Bird       Dog
Dog   Frog  Bird   Alligator Frog       Alligator
Shark Bird  Bird   Monkey    Alligator

需要得到每行的唯一值，横向排列的结果：

Cat   Dog    Monkey    Bird
Dog   Frog   Bird      Alligator
Shark Bird   Monkey    Alligator

你尝试过「数据>高级筛选>选择不重复记录」、TRANSPOSE搭配UNIQUE函数的方法，但都没达到预期效果。

VBA代码解决方案 #

下面是可以直接使用的VBA代码，专门处理每行的横向去重：

Sub RemoveRowDuplicates()
    Dim ws As Worksheet
    Dim rng As Range
    Dim row As Range
    Dim cell As Range
    Dim uniqueCol As Collection
    Dim i As Integer
    
    ' 操作当前激活的工作表
    Set ws = ActiveSheet
    ' 让你手动选择要处理的数据区域
    Set rng = Application.InputBox("请框选需要处理的数据区域", Type:=8)
    
    ' 逐行处理
    For Each row In rng.Rows
        Set uniqueCol = New Collection
        ' 捕获重复项添加的错误，避免报错中断
        On Error Resume Next
        For Each cell In row.Cells
            ' 跳过空单元格
            If cell.Value <> "" Then
                ' 用单元格内容作为唯一键，自动过滤重复值
                uniqueCol.Add cell.Value, Key:=CStr(cell.Value)
            End If
        Next cell
        On Error GoTo 0 ' 恢复正常错误处理
        
        ' 把唯一值写回当前行开头
        For i = 1 To uniqueCol.Count
            row.Cells(i).Value = uniqueCol(i)
        Next i
        ' 清空该行后面多余的重复值单元格
        For i = uniqueCol.Count + 1 To row.Cells.Count
            row.Cells(i).ClearContents
        Next i
    Next row
    
    MsgBox "处理完成！"
End Sub

新手使用步骤（从未接触过宏的用户） #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器；
2. 在左侧的「工程资源管理器」里，右键点击你要处理的工作表（比如Sheet1），选择「插入」→「模块」；
3. 把上面的代码复制粘贴到弹出的模块代码窗口里；
4. 返回Excel界面，按下Alt + F8，在弹出的宏列表里选RemoveRowDuplicates，点击「执行」；
5. 跟着提示用鼠标框选需要处理的所有数据区域，点击确定就完成了。

内容的提问来源于stack exchange，提问作者BFF