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

下面给出的是我正在使用的数据的一个例子正如你可以看到它有重复的条目（实际的数据库是30000条目）

我想find一个方法，我可以删除重复的行基于列出的百分比相应的列。

该方法应该比较重复的行百分比，select最高的一个，丢弃另一个

这个问题（初始）：

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

任何帮助，将不胜感激！

Answer 1

尝试这个。 它将（应）通过电子邮件和百分比列对数据进行sorting，然后删除重复的数据，保留最高的百分比。

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步：按百分比降序sorting。

步骤2：使用数据function区上的“删除重复”function。 仅在“电子邮件”列中使用它。

Answer 3

1- clic DATA选项卡

2，select你的数据，并clic 删除重复

3-select相应的列并点击确定。

Answer 4

这里是以下post的修改版本： 删除所有行，如果重复在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