通过比较列删除excel中的重复行

Question

以下是我正在使用的数据示例 如您所见，它有重复的条目。（实际数据库是 30000 个条目）

我想找到一种方法，了解如何根据列出百分比的相应列删除重复行。

该方法应比较重复行百分比并选择最高的一个并丢弃另一个

这个问题（初始）：

我希望这个输出清楚。 这是结果，我要

任何帮助将不胜感激！

Answer 1

试试这个。它将（应该）按电子邮件和百分比列对数据进行排序，然后删除重复项，保持最高百分比不变。

With ActiveSheet
    .Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Sort _
        Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes, KEY2:=Range("B1"), Order2:=xlDescending, Header:=xlYes
    .Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).RemoveDuplicates Columns:=Array(1), Header:=xlYes
End With

Answer 2

如果你只需要这个方法一次，你可以手动完成。

第 1 步：按百分比降序排序。

第 2 步：使用数据功能区上的“删除重复项”功能。仅在“电子邮件”列中使用。

Answer 3

1-单击数据选项卡

2-选择您的数据并单击 删除重复项

3-选择对应的列并单击确定。

Answer 4

这是以下帖子的修改版本： Delete all rows if duplicate in excel - VBA

Sub remDup2()
    Dim rng As Range, dupRng As Range, lastrow As Long, ws As Worksheet
    Dim col As Long, col2 As Long, offset As Long, deletecurrent As Boolean

    'Disable all the stuff that is slowing down
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'Define your worksheet here
    Set ws = Worksheets(1)

    'Define your column and row offset here
    col = 1    'Column with E-Mail
    col2 = 2   'Column with percentage
    offset = 1 'Startrow with entries

    'Find first empty row
    Set rng = ws.Cells(offset + 1, col)
    lastrow = rng.EntireColumn.Find( _
                What:="", After:=ws.Cells(offset + 1, col)).Row - 1

    'Loop through list
    While (rng.Row < lastrow)
        Do
            Set dupRng = ws.Range(ws.Cells(rng.Row + 1, col), ws.Cells(lastrow, col)).Find( _
                    What:=rng, LookAt:=xlWhole)
            If (Not (dupRng Is Nothing)) Then
                If (ws.Cells(rng.Row, col2) > ws.Cells(dupRng.Row, col2)) Then
                    dupRng.EntireRow.Delete
                    lastrow = lastrow - 1
                Else
                    deletecurrent = True
                    Exit Do
                End If
                If (lastrow = rng.Row) Then Exit Do
            Else
                Exit Do
            End If
        Loop

        Set rng = rng.offset(1, 0)

        'Delete current row
        If (deletecurrent) Then
            rng.offset(-1, 0).EntireRow.Delete
            lastrow = lastrow - 1
        End If

        deletecurrent = False
    Wend

    'Enable stuff again
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub