Question

下面的代码在新工作表上创建了一组新数据，但即使它是重复的，它也会采用符合要求的所有内容。如何更改代码以消除新数据集中的重复项？

＆＃13;

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

＆＃13;

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

    ...

vba从新集中删除重复项

1 个答案: