excel - 从表中的当前选择中删除重复项

Question

我正在尝试从表中的某个范围中删除重复的联系人。
而是从整个表中删除重复项，而不仅仅是当前选择。
同一个联系人可以在表中的不同项目下。我只是不想在同一个项目下重复该联系人。
这是我的意思的一个示例。实际上有更多的联系人和项目。

它应该只从最后一个项目输入中删除重复的 Contact 9。不应删除联系人 1 和联系人 2。

Dim rng As Range

'Rowies is defined elsewhere as the top row of the last entered project, in this sample it would be A8
Rowies.Select

Range(Selection, Selection.Offset(0, 3)).Select

Set rng = Range(Selection, Selection.End(xlDown))

'i have duplicates removed based upon their email addresses.
rng.RemoveDuplicates Columns:=4, Header:=xlNo

Answer 1

这将使用字典删除项目中的所有重复行。它不依赖于选择范围，它只是贯穿所有项目。
我假设您的数据从 A 列开始，B 列是最长的列。

Sub removeDupes()
    Dim i As Long
    Dim lr As Long
    
    Dim dict As Object
    Dim project As String
    
    Dim delrng As Range
    Set dict = CreateObject("Scripting.Dictionary") 'Reference is Microsoft Scripting Runtime if you want early binding
    
    With Sheets("Sheet1") 'Change as needed
        lr = .Cells(.Rows.Count, 2).End(xlUp).Row
        
        For i = 2 To lr
            If .Cells(i, 1).Value <> "" Then
                project = .Cells(i, 1).Value
            End If
            
            If Not dict.exists(project & .Cells(i, 2).Value) Then
                dict.Add project & .Cells(i, 2).Value, ""
            Else
                If delrng Is Nothing Then
                    Set delrng = .Rows(i).EntireRow
                Else
                    Set delrng = Union(delrng, .Rows(i).EntireRow)
                End If
            End If
        Next i
        if not delrng is nothing then
            delrng.Delete
        end if
    End With
                    
End Sub