比较3列和删除重复项vba

Question

在下面的这种情况下，我想比较一列与两列重复。在下面的图像中，列D与列B和F进行比较，并且从那里我希望能够从列D中删除重复项。我已经在线查看，我不知道如何做到这一点。

Answer 1

如果搜索列始终位于D列，另外两个位于B和F中，则会清除重复数据。

注意：这只会删除中间列中的数据，而不会实际填补剩余的空白。

Person.Name

Answer 2

使用集合的更高效版本。它只对列B和F进行一次迭代，并且可以在生成的集合中立即查找值而无需迭代。

Sub deleteDups()

    ' setup column ranges
    Dim rngB As Range
    Dim rngD As Range
    Dim rngF As Range

    With ActiveSheet
        Set rngB = .Range(.[b2], .[b2].End(xlDown))
        Set rngD = .Range(.[d2], .[d2].End(xlDown))
        Set rngF = .Range(.[f2], .[f2].End(xlDown))
    End With

    ' store columns B and F in collections with value = key
    Dim colB As New Collection
    Dim colF As New Collection

    Dim c As Range
    For Each c In rngB: colB.Add c, c: Next
    For Each c In rngF: colF.Add c, c: Next

    ' quickly check if the value in any of the columns
    For Each c In rngD
        If contains(colB, CStr(c)) Or contains(colF, CStr(c)) Then
            Debug.Print "Duplicate """ & c & """ at address " & c.Address
            ' c.Clear ' clears the duplicate cell
        End If
    Next

End Sub

Function contains(col As Collection, key As String) As Boolean
    On Error Resume Next
    col.Item key
    contains = (Err.Number = 0)
    On Error GoTo 0
End Function

输出：

Duplicate "cry" at address $D$4
Duplicate "car" at address $D$5
Duplicate "cat" at address $D$6