vba删除新集合中的重复项

下面的代码在一张新纸上创build了一组新的数据，但是即使它是重复的，它也会将所有与需求相匹配的数据。 如何更改代码以消除新数据集中的重复项？

Sub Testerss() Dim c As Range, v As String, arr, x As Long, e Dim d As Range Dim ws As Worksheet Set d = Worksheets("Sheet3").Range("D1") For Each c In ActiveSheet.Range("D25:D105") v = Trim(c.Value) If Len(v) > 0 Then v = Replace(v, vbLf, " ") Do While InStr(v, " ") > 0 v = Replace(v, " ", " ") Loop arr = Split(v, " ") For x = LBound(arr) To UBound(arr) e = arr(x) If Not IsError(Application.Match(LCase(e), Array("(bye)", "(hello)"), 0)) Then If x > LBound(arr) Then d.Value = arr(x - 1) & " " & e Else d.Value = "??? " & e End If Set d = d.Offset(1, 0) End If Next x End If Next c End Sub​ 

Answer 1

您可以添加一个检查，看看结果是否已被复制。 首先设定一个范围的结果

 finalRow = Worksheets("Sheet3").Cells(1000000, 4).end(xlup).row Set resultRange = Worksheets("Sheet3").Range("D1:D" & finalRow) 

现在看看你正在检查的价值是否在这个范围内

 duplicate = false for each result in resultRange if v = result.Value then duplicate = true Exit For end if next 

现在在继续之前也检查重复

 If Len(v) > 0 and not duplicate then 

全部一起

 Set d = Worksheets("Sheet3").Range("D1") For Each c In ActiveSheet.Range("D25:D105") finalRow = Worksheets("Sheet3").Cells(1000000, 4).end(xlup).row Set resultRange = Worksheets("Sheet3").Range("D1:D" & finalRow) v = Trim(c.Value) duplicate = false for each result in resultRange if v = result.Value then duplicate = true Exit For end if next If Len(v) > 0 and not duplicate then ...