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

Question

Need some help here. Nothing that I've searched for seems to fit my situation. I have a large data set where Column A and Column B have some duplicates. To clarify, it is a personnel data set with Column A being employees and column B being spouses of those employees. However, some employees are married to each other, so I would like to delete the second instance on the list where both employees are married to each other. A sample of my data is this:

Column A  
Kim  
Dave  
Jim  
Mary  
Mike  

---

Column B  
Mike  
Angela  
Susan  
Bob  
Kim

In this case, Mike is married to Kim, which is depicted in both rows 1 and 5. I want to delete row 5. It is a rather large dataset, so doing it manually would take hours with a probability of human error. Thanks!\\

Edited to include my code:

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

Answer 1

Put this formula in C1 (Assuming your data starts in A1 and B1) =COUNTIFS(A$1:A1,B1,B$1:B1,A1)

Drag down

Filter data to remove none 0

It works using an expanding range, counting the occurrence of the flip. An expanding range is used to stop it from counting the original ie the one you want to keep.

Here is my sample data and results:

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

Answer 2

You should be able to change this to suit your needs. It compares columns A & B to look for duplicates and if found, deletes them. It's code I previously wrote for something else but you're welcome to see if it works for you.

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

You could use this formula:

=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",""),"")

In an empty column, like column C put it in C1, confirm with Ctrl-Shift-Enter. Then Copy down. I t will put "Duplicate" in the second version of any matches it finds.

Then sort on column C to bring "Duplicate" to the top and delete all those rows.