vba刪除新集中的重複項

Question

下面的代碼在新工作表上創建了一組新的數據，但它將所有與需求匹配的內容即使是重複的。如何更改代碼以消除新數據集中的重複項？

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 

    ...