Excel删除具有不同字符串顺序的重复单元格

Question

如何删除具有不同数据顺序的重复单元格

A header
it is amazing day
it is amazing
amazing day
amazing day it is

预期结果

A header
it is amazing day
it is amazing
amazing day

请注意，我的 Cells 字符串最多可达 7 个

Answer 1

将字符串拆分为单词，对它们进行排序以创建键并使用字典查找重复项。

Option Explicit

Sub RemoveDuplicates()

    Dim ws As Worksheet, ar, s As String
    Dim lastrow As Long, i As Long, n As Long
    
    Dim dict As Object, key As String, rng As Range
    Set dict = CreateObject("Scripting.Dictionary")
   
    Set ws = Sheet1
    With ws
       lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
       For i = 2 To lastrow
            
            ' split and sort words into key
            s = Application.Trim(.Cells(i, "A"))
            ar = bubblesort(Split(s, " "))
            key = Join(ar, " ")
            
            ' check dupicate
            If dict.exists(key) Then
                .Cells(i, "B") = "Duplicated"
                If n = 0 Then
                    Set rng = .Rows(i)
                Else
                    Set rng = Application.Union(rng, .Rows(i))
                End If
                n = n + 1
            Else
                .Cells(i, "B") = "Unique"
                dict.Add key, i
            End If
            
       Next
    End With
       
    ' delete duplicates
    If n > 0 Then
        If MsgBox(n & " duplicates found, do you want to delete them ?", vbYesNo) = vbYes Then
            rng.Delete
        End If
    Else
        MsgBox "No duplicates found", vbInformation
    End If
   
End Sub

Function bubblesort(ar)
    Dim a As Long, b As Long, tmp As String
    For a = 0 To UBound(ar)
         For b = a + 1 To UBound(ar)
             If CStr(ar(a)) > CStr(ar(b)) Then
                 tmp = ar(a)
                 ar(a) = ar(b)
                 ar(b) = tmp
             End If
         Next
     Next
     bubblesort = ar
End Function