多列相同去重复，提取没有重复行

吴永飞

跪求论坛大神！多列相同去重复，提取没有重复行

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For j = 1 To UBound(arr)
        str1 = ""
        For i = 1 To UBound(arr, 2)
            str1 = str1 & ":" & arr(j, i)
        Next i
        If d.exists(str1) Then
            Set d(str1) = Union(Cells(j, 1), d(str1))
        Else
            Set d(str1) = Cells(j, 1)
        End If
    Next j
    r = 0
    For Each k In d.keys
        If d(k).Cells.Count = 1 Then
            r = r + 1
            d(k).EntireRow.Copy Sheets(2).Cells(r, 1)
        End If
    Next k
End Sub

liulang0808

附件内容供参考。。。。。。。

准提部林

Sub TEST_A1()
Dim Arr, xD, T$, i&, R&
Set xD = CreateObject("scripting.dictionary")
With Sheet1.[a1].CurrentRegion
     Arr = .Value
     For i = 1 To UBound(Arr)
         For j = 1 To UBound(Arr, 2)
             T = T & "," & Arr(i, j)
         Next
         xD(T) = xD(T) + 1:  Arr(i, 1) = T:  T = ""
     Next i
     For i = 1 To UBound(Arr)
         If xD(Arr(i, 1)) = 1 Then R = R + 1: .Rows(i).Copy Sheet2.Cells(R, 1)
     Next i
End With
End Sub

吴永飞

非常感谢liulang0808老师帮助