需要一些帮助。我搜索的任何东西似乎都不适合我的情况。我有一个大型数据集,其中A列和B列有一些重复。为了澄清,它是一个人员数据集,其中A列是雇员,B列是这些雇员的配偶。但是,有些员工彼此结婚,所以我想删除列表中的第二个实例,这两个员工都是彼此结婚的。我的数据样本如下:
Column A
Kim
Dave
Jim
Mary
Mike
Column B
Mike
Angela
Susan
Bob
Kim
在这种情况下,Mike与Kim结婚,在第1行和第5行中都有描述。我想删除第5行。这是一个相当大的数据集,因此手动执行此操作需要数小时才会出现人为错误。谢谢!\
编辑包含我的代码:
Sub DeleteDuplicates()
Application.ScreenUpdating = False
'Declare variables
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean
'Set up the count as the number of filled rows in the first column of Sheet1.
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
'Cycle through all the cells in that column:
For iRow = 2 To iRowL
'For every cell that is not empty, search through the first column in each worksheet in the
'workbook for a value that matches that cell value.
If Not IsEmpty(Cells(iRow, 2)) Then
For iSheet = ActiveSheet.Index + 1 To Worksheets.Count
bln = False
var = Application.Match(Cells(iRow, 2).Value, ActiveSheet.Columns(9), 0)
'If you find a matching value, clear the cell contents and exit the loop;
'otherwise, continue searching until you reach the end of the workbook.
If Not IsError(var) Then
bln = True
Exit For
End If
Next iSheet
End If
'If you do not find a matching value, do nothing, if you do find a matching value, clear the contents of the cell
If bln = True Then
ActiveSheet.Rows(iRow).EntireRow.Delete
End If
Next iRow
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:1)
将此公式放在C1中(假设您的数据以A1和B1开头)<p class='fake-horizontal-rule'>_________________________________________________________</p>
p.fake-horizontal-rule{
color:#ccc;
text-align:center;
}
向下拖动
过滤数据以删除无0
它使用扩展范围,计算翻转的发生。扩展范围用于阻止它计算原始数据,即您要保留的原始数据。
以下是我的示例数据和结果:
=COUNTIFS(A$1:A1,B1,B$1:B1,A1)
答案 1 :(得分:0)
您应该能够根据自己的需要进行更改。它比较A列和A列。 B查找重复项,如果找到,则删除它们。这是我以前写的其他东西的代码,但欢迎你看看它是否适合你。
Sub FindDuplicates()
Dim i As Long, j As Long
Dim numberOfAccounts As Long, numberOfBillClasses As Long
Dim nxtRow As Long
Dim checkForRange As Range, DupeRange As Range
numberOfAccounts = Range("B" & Rows.Count).End(xlUp).Row
esrd = Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To numberOfAccounts
Set checkForRange = Range("B" & i)
For j = 1 To esrd - 1
Set DupeRange = Range("A" & j)
If StrComp(CStr(checkForRange.Value), CStr(DupeRange.Value), vbTextCompare) = 0 Then
checkForRange.Interior.ColorIndex = 22
End If
Set DupeRange = Nothing
Next j
Set checkForRange = Nothing
Next i
End Sub
'This macro will delete the duplicates found after using the above macro.
Sub DeleteDuplicates()
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Lastrow = Range("B" & Rows.Count).End(xlUp).Row
For Lrow = Lastrow To 2 Step -1
If Cells(Lrow, "B").Interior.ColorIndex = 22 Then
Cells(Lrow, "B").Delete
End If
Next Lrow
'Removes color from duplicate cells
Columns("B:B").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
答案 2 :(得分:0)
你可以使用这个公式:
=IFERROR(IF(AND(SUM(($A:$A&$B:$B=A1&B1)+($B:$B&$A:$A=A1&B1))>1,ROW(INDEX($B:$B,MATCH(A1,$B:$B,0)))<ROW()),"Duplicate",""),"")
在空列中,如C列将其放入C1中,使用Ctrl-Shift-Enter确认。然后复制下来。我会在它找到的任何匹配项的第二个版本中加上“Duplicate”。
然后对C列进行排序,将“Duplicate”置于顶部并删除所有这些行。