如何洗掉具有不同資料順序的重復單元格
| 一個標題 |
|---|
| 這是驚人的一天 |
| 太棒了 |
| 美好的一天 |
| 這是驚人的一天 |
預期結果
| 一個標題 |
|---|
| 這是驚人的一天 |
| 太棒了 |
| 美好的一天 |
請注意，我的單元格字串最多可達 7 個
uj5u.com熱心網友回復：
將字串拆分為單詞，對它們進行排序以創建一個鍵并使用字典查找重復項。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/392969.html
上一篇：無法向JSON檔案添加/追加元素