Question

我处于紧急状态。非常感谢专家提供的任何帮助。已经有好几次询问过的原理。我已经尝试了很多方法。但似乎没有什么可以解决我的问题。

我的查询是我有3列，都有电子邮件地址。我想运行一些东西，它将识别所有列中的任何重复并删除重复保持原始值。我尝试删除重复但它只适用于一列。我使用过excel 2013.I已经分享了我的数据和最近的VBA代码，这些代码都是从这里开始的。

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

Sub RemoveDups（）

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

End Sub

＆＃39;此函数将返回对工作表中工作表或指定列中最后一个单元格的引用。公共函数LastCell（wrkSht As Worksheet，可选Col为Long = 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

结束功能

Answer 1

这对我有用。只需将表单编号替换为您正在使用的表单编号。我有Sheet1作为持有人。

 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

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

1 个答案: