如果 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 列上排序以將“重復”帶到頂部並刪除所有這些行。