如果 A 列中的单元格等于 B 列中的单元格，则 Excel 宏将删除一行

Question

这里需要一些帮助。 我搜索的任何内容似乎都不适合我的情况。 我有一个大数据集，其中 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

结束子

Answer 1

将此公式放在 C1 中（假设您的数据从 A1 和 B1 开始） =COUNTIFS(A$1:A1,B1,B$1:B1,A1)

拖累

过滤数据以删除无 0

它使用扩展范围工作，计算翻转的发生。 扩大范围用于阻止它计算原件，即您想要保留的那个。

这是我的示例数据和结果：

Kim     Mike    0
Bob     Mary    0
Jim     Susan   0
Mary    Bob     1
Dave    Angela  0
Mike    Kim     1

Answer 2

您应该能够更改此设置以满足您的需求。 它比较 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

Answer 3

你可以使用这个公式：

=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 确认。 然后复制下来。 它会将“重复”放在它找到的任何匹配项的第二个版本中。

然后在 C 列上排序以将“重复”带到顶部并删除所有这些行。