多列搜索电子邮件地址,查找重复值并删除



我处于紧急情况下。专家的任何帮助将不胜感激。抱歉,因为它已经被问了好几次。我已经尝试了很多方法。但似乎没有什么能解决我的问题。

我的查询是我有 3 列,都有电子邮件地址。我想运行一些东西,它将识别所有列中的任何重复项并删除保留原始值的重复项。我尝试删除重复项,但它仅适用于一列。我使用了Excel 2013.我已经与您分享了我的数据和最近的VBA代码。

https://docs.google.com/spreadsheets/d/1iCvKBZbuOyWAzDvKfRvDgT41x8VQO-V-OXMgcBbJQko/edit?usp=sharing

子删除重复((

Dim wrkSht As Worksheet
Dim lLastCol As Long
Dim lLastRow As Long
Dim i As Long
'Work through each sheet in the workbook.
For Each wrkSht In ThisWorkbook.Worksheets
    'Find the last column on the sheet.
    lLastCol = LastCell(wrkSht).Column
    'Work through each column on the sheet.
    For i = 1 To lLastCol
        'Find the last row for each column.
        lLastRow = LastCell(wrkSht, i).Row
        'Remove the duplicates.
        With wrkSht
            .Range(.Cells(1, i), .Cells(lLastRow, i)).RemoveDuplicates Columns:=1, Header:=xlNo
        End With
    Next i
Next wrkSht

结束子

'此函数将返回对工作表或工作表上指定列中最后一个单元格的引用。公共函数 LastCell(wrkSht 作为工作表,可选列只要 = 0( 作为范围

Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht
    If Col = 0 Then
        lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Else
        lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
    End If
    If lLastCol = 0 Then lLastCol = 1
    If lLastRow = 0 Then lLastRow = 1
    Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End With
On Error GoTo 0

结束功能

这对

我有用。只需将工作表编号替换为您正在使用的编号即可。我有工作表 1 作为持有人。

 Sub RemoveDups()
Dim ws As Worksheet
Dim col As Range
For Each col In Sheet2.Range("A:C").Columns
    Sheet1.Range(col.Address).RemoveDuplicates Columns:=1, Header:=xlNo
Next col
End Sub

最新更新